Copier coller de selection mutiple

[treza88]

Bonjour a tous,

Je bloque sur un problème de copier coller sur une sélection multiple et je n'arrive pas a trouver de solution.

Voici mon code:

Set rang1 = Range("B5", ActiveSheet.Range("F65536").End(xlUp))
    Set rang2 = Range("H5", ActiveSheet.Range("J65536").End(xlUp))
    Set rang3 = Range("M5", ActiveSheet.Range("M65536").End(xlUp))
    Set rang4 = Range("N5", ActiveSheet.Range("R65536").End(xlUp))
    Set rang5 = Range("AE5", ActiveSheet.Range("AG65536").End(xlUp))
    Set rang6 = Range("AJ5", ActiveSheet.Range("AJ65536").End(xlUp))
    Set rang7 = Range("AQ5", ActiveSheet.Range("AU65536").End(xlUp))

    Set MyRange = Union(rang1, rang2, rang3, rang4, rang5, rang6, rang7)
    MyRange.Copy

    Workbooks.Add

    Range("B1").PasteSpecial Paste:=xlPasteValues

Et forcement ça bloque a:

MyRange.Copy

Merci d'avance

 

[Staple1600]

Bonsoir le fil, le forum


Pour te mettre sur une piste ou en guise d'inspiration
(ce n'est donc pas une solution)

Sub a()
Dim adresses
Set rang1 = Range("B5", ActiveSheet.Range("B65536").End(xlUp))
Set rang2 = Range("H5", ActiveSheet.Range("H65536").End(xlUp))
Set rang3 = Range("M5", ActiveSheet.Range("M65536").End(xlUp))
'Set rang4 = Range("N5", ActiveSheet.Range("R65536").End(xlUp))
'Set rang5 = Range("AE5", ActiveSheet.Range("AG65536").End(xlUp))
'Set rang6 = Range("AJ5", ActiveSheet.Range("AJ65536").End(xlUp))
'Set rang7 = Range("AQ5", ActiveSheet.Range("AU65536").End(xlUp))
Set Myrange = Union(rang1, rang2, rang3)
adresses = Split(Myrange.Address, ",")
For i = LBound(adresses) To UBound(adresses)
Range(adresses(i)).Copy Sheets(2).Range("B1").Offset(, i - 1)
Next
End Sub

NB: Ici la copie se fait sur la feuille 2 du classeur actif.

 

[treza88]

Bonjour et merci Staple 1600,

j'ai essayer d'utiliser ton code qui apparemment fonctionne, mais je ne vois pas le résultat car quand j'essaye de le coller j'ai une erreur avec PasteSpecial dans le code suivant:

Range("B1").PasteSpecial Paste:=xlPasteValues

 

[Staple1600]

Re

Relis mon précédent message
Notamment la première phrase

Ensuite dis-moi où tu lis cette ligne dans ma macro...
Range("B1").PasteSpecial Paste:=xlPasteValues

 

[treza88]

Ok je viens de retester j'arrive a coller un résultat mais qui ne correspond pas a ce que j'ai dans mes plages et je ne comprends pas le résultat du collage.
ça ne me dérange pas de chercher la solution, mais pour l'instant je n'arrive pas a faire le lien avec tes infos et la solution, mes compétences me limite.
j'ai essayer d'utiliser le code juste avec rang1 mais avec Union il faut plusieurs arguments.
J'ai essayé avec deux arguments mais j'ai le même résultat après collage qu'avec 3 arguments.
Donc je suis un peu perdu.

 

[Staple1600]

Re

Et là, tu retrouves ton chemin ?

Sub b()
Dim i&, j&
With ActiveSheet
    Set rang1 = Range("B5", .Range("F65536").End(xlUp))
    Set rang2 = Range("H5", .Range("J65536").End(xlUp))
    Set rang3 = Range("M5", .Range("M65536").End(xlUp))
    Set rang4 = Range("N5", .Range("R65536").End(xlUp))
    Set rang5 = Range("AE5", .Range("AG65536").End(xlUp))
    Set rang6 = Range("AJ5", .Range("AJ65536").End(xlUp))
    Set rang7 = Range("AQ5", .Range("AU65536").End(xlUp))
    Set MyRange = Union(rang1, rang2, rang3, rang4, rang5, rang6, rang7)
    t = Split(MyRange.Address, ",")
    For i = LBound(t) To UBound(t)
    Range(t(i)).Copy Sheets(2).Range("B1").Offset(0, j - i)
    j = i + Sheets(2).Cells(1, Sheets(2).Columns.Count).End(xlToLeft).Column
    Next
End With
End Sub

 

[treza88]

Merci c'est un peu plus clair, mais j'ai encore quelques soucis.

J'ai exécuter le code suivant légèrement modifier pour coller les plages dans la même feuille mais a partir de B20.
je l'ai exécuter boucle après boucle et la première boucle me colle le bon résultat au bon endroit mais les suivantes sont collé a partir de L20 et toutes les unes sur les autres.

Dim i&, j&
With ActiveSheet
  Set rang1 = Range("C5", .Range("F65536").End(xlUp))
  Set rang2 = Range("H5", .Range("J65536").End(xlUp))
  Set rang3 = Range("M5", .Range("M65536").End(xlUp))
  Set rang4 = Range("N5", .Range("R65536").End(xlUp))
  Set rang5 = Range("AE5", .Range("AG65536").End(xlUp))
  Set rang6 = Range("AJ5", .Range("AJ65536").End(xlUp))
  Set rang7 = Range("AQ5", .Range("AU65536").End(xlUp))
  Set MyRange = Union(rang1, rang2, rang3, rang4, rang5, rang6, rang7)
  t = Split(MyRange.Address, ",")
  For i = LBound(t) To UBound(t)
  Range(t(i)).Copy ActiveSheet.Range("B20").Offset(0, j - i)
  j = i + ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column
  Stop
  Next
End With

 

[Staple1600]

Re

Dans ton premier code , tu créais un nouveau classeur
Moi j'ai écris ma macro pour recopier sur une nouvelle feuille.
Et là tu changes encore la donne???

Tu es sur d'avoir compris cette ligne et à quoi sert ceci?
Sheets(2).Cells(1, Sheets(2).Columns.Count).End(xlToLeft).Column

 

[treza88]

Sur non, pas vraiment, mais pour moi le code prenais les info sur la feuille 1 et les copiais sur la feuille 2, seulement moi ma feuille est en septième position pas en première, j'ai voulu donc tester le code dans la feuille active car ça me paraissait compliqué pour moi dans un premier temps de l'exécuter dans la première feuille d'un nouveau classeur.
Mais du coup j'ai du louper quelque chose pour que le code fonctionne.

 

[Staple1600]

Re

Mon code tel qu'il est écrit recopie les données sur la feuille 2
en décalant les colonnes lors de la recopie
Voici un petit exemple
(à tester sur un classeur vierge avec deux feuilles vides)
Lancer la macro ci-dessous en étant sur la feuille 1
Ensuite va voir le résultat en feuille 2

Sub d()
Dim i&, j&
With ActiveSheet
.Range("A1:H17").Formula = "=INT((ROW()*COLUMN()*NOW())/1600)"
.Range("A1:H17").Value = .Range("A1:H17").Value
    Set rang1 = Range("A1", .Range("C65536").End(xlUp))
    Set rang2 = Range("D1", .Range("E65536").End(xlUp))
    Set rang3 = Range("F1", .Range("H65536").End(xlUp))
    rang1.Interior.Color = vbYellow: rang2.Interior.Color = vbBlue: rang3.Interior.Color = vbRed
    Set MyRange = Union(rang1, rang2, rang3)
    MsgBox "Suite du test"
    t = Split(MyRange.Address, ",")
    For i = LBound(t) To UBound(t)
    Range(t(i)).Copy Sheets(2).Range("B1").Offset(0, j - i)
    j = i + Sheets(2).Cells(1, Sheets(2).Columns.Count).End(xlToLeft).Column
    Next
End With
End Sub

 

[treza88]

Bonjour Staple1600,

je viens de suivre tes conseils et utiliser ton code dans un nouveau classeur, il fonctionne en partie, je m'explique.
Quand je fait un copier coller du rang1 et rang2 pas de soucis mais quand je rajoute le rang3 il se passe un chevauchement et je ne comprends pas pourquoi.
Ensuite le code colle le contenu de la cellule alors que je ne voudrais que la valeur de la cellule, comment faire?
je joint le fichier avec lequel j'ai mes données: