Copier Coller un range en séparant chaque colonne par 2 colonnes (Offset?)

[WaxistSelecta]

Bonjour le fil,

je reviens sur le forum pour un besoin surement pas compliqué mais que je n'arrive pas à écrire correctement dans mon code

Je présume qu'il s'agit d'utiliser le Offset mais je ne l'utilise pas de la bonne manière...

En gros, j'ai la boucle For suivante :

For Each Sh In ThisWorkbook.Worksheets

If Sh.Name <> "Lancement" And Sh.Name <> "Conso à date par région" And Sh.Name <> "Conso histo par région" Then
    Set wb = Workbooks.Open("C:\Templates\Template Report Région.xls")
    Sh.Range("A2:H60").Copy Destination:=wb.Sheets("Votre Région a date").Range("A65536").End(xlUp)(2)
    Sh.Range("I2", Sh.Range("I2").Columns.End(xlToRight)).Resize(26).Copy Destination:=wb.Sheets("Votre Région a date").Range("K7")
    
   
 
 wb.SaveAs ("C:\Templates\" & Workbooks("Template Report Région.xls").Sheets("Votre Région a date").Range("B7").Value & ".xls")
        'Fermeture du fichier crée
 wb.Close

End If
  Next Sh

Cette boucle récupère des données d'un ensemble d'onglet pour les coller dans un template (autre fichier).

Mon besoin :

Au moment du collage, j'aurais besoin que dans le range à coller, on sépare chaque colonne de 2 colonnes.
Ceci pour que les données s'insère bien dans le template tel qu'il est conçu.

Merci à celles / ceux qui pourront m'aider à résoudre mon problème !

Waxist

 

[job75]

Re : Copier Coller un range en séparant chaque colonne par 2 colonnes (Offset?)

Bonjour WaxistSelecta,

Je vous laisse tester ce code :

Dim Sh As Worksheet, wb As Workbook, cel As Range, i As Byte, col As Range
For Each Sh In ThisWorkbook.Worksheets
  If Sh.Name <> "Lancement" And Sh.Name <> "Conso à date par région" And Sh.Name <> "Conso histo par région" Then
    Set wb = Workbooks.Open("C:\Templates\Template Report Région.xls")
    Set cel = wb.Sheets("Votre Région a date").Range("A65536").End(xlUp)(2)
    i = 0
    For Each col In Sh.Range("A2:H60")
      col.Copy cel.[COLOR="Red"]Offset(, 3 * i)[/COLOR]
      i = i + 1
    Next
    i = 0
    Set cel = wb.Sheets("Votre Région a date").Range("K7")
    For Each col In Sh.Range("I2", Sh.Range("I2").End(xlToRight)).Resize(26)
      col.Copy cel.[COLOR="red"]Offset(, 3 * i)[/COLOR]
      i = i + 1
    Next
    wb.SaveAs ("C:\Templates\" & Workbooks("Template Report Région.xls").Sheets("Votre Région a date").Range("B7").Value & ".xls")
    'Fermeture du fichier crée
    wb.Close
  End If
Next Sh

Offset(, 3 * i) décale chaque collage de 3 colonnes.

Edit : avec le .Range("K7") n'y a-t-il pas risque de chevauchement avec lez zones de collage précédentes ? A vous de voir...

A+

 

[WaxistSelecta]

Re : Copier Coller un range en séparant chaque colonne par 2 colonnes (Offset?)

Merci!

Je vais tester votre code Job75.

Pour répondre à l'interrogation sur le chevauchement, en fait pour le offset elle ne concerne que la deuxième partie du range (à partir du I), donc à priori pas de risque de chevauchement


Merci encore pour votre aide!

 

[job75]

Re : Copier Coller un range en séparant chaque colonne par 2 colonnes (Offset?)

Re,

Pour répondre à l'interrogation sur le chevauchement, en fait pour le offset elle ne concerne que la deuxième partie du range (à partir du I), donc à priori pas de risque de chevauchement

Cela est bien sûr vrai si l'on copie les colonnes sans les décaler au collage.

Mais là on décale...

A priori au lieu de :

i = 0
Set cel = wb.Sheets("Votre Région a date").Range("K7")

il faudra probablement écrire :

Set cel = wb.Sheets("Votre Région a date").Range("K7").Offset(, 3 * i)
i = 0

A+

 

[job75]

Re : Copier Coller un range en séparant chaque colonne par 2 colonnes (Offset?)

Re,

Eh bien, il y a plus simple : remplacer K7 par Y7...

i = 0
Set cel = wb.Sheets("Votre Région a date").Range("[COLOR="Red"]Y7[/COLOR]")

A+

 

[WaxistSelecta]

Re : Copier Coller un range en séparant chaque colonne par 2 colonnes (Offset?)

Merci Job75,

Pour revenir sur le sujet, j'ai fait un test, en conservant la première partie de mon collage sur le range A2:H60 qui etait ok.

Le code fonctionne presque mais tombe en erreur au niveau de la ligne

col.Copy cel.Offset(0, 3 * i)

Si je consulte le fichier de destination encore ouvert, le offset fonctionne bien mais il semble que le collage s'effectue en transposant toutes les valeurs sur la ligne 2

Voici mon code pour info :

Sub test()

Dim Sh As Worksheet, wb As Workbook
Dim cel As Range
Dim i As Byte
Dim col As Range

For Each Sh In ThisWorkbook.Worksheets
  If Sh.Name <> "Lancement" And Sh.Name <> "Conso à date par région" And Sh.Name <> "Conso histo par région" Then
    Set wb = Workbooks.Open("C:\Templates\Template Report Région.xls")
    Sh.Range("A2:H60").Copy Destination:=wb.Sheets("Votre Région a date").Range("A65536").End(xlUp)(2)
  
    Set cel = wb.Sheets("Votre Région a date").Range("K7")
    i = 0
    For Each col In Sh.Range("I2", Sh.Range("I2").End(xlToRight)).Resize(26)
      col.Copy cel.Offset(0, 3 * i)
      i = i + 1
    Next
    wb.SaveAs ("C:\Templates\" & Workbooks("Template Report Région.xls").Sheets("Votre Région a date").Range("B7").Value & ".xls")
    'Fermeture du fichier crée
    wb.Close
  End If
Next Sh

End Sub

 

[job75]

Re : Copier Coller un range en séparant chaque colonne par 2 colonnes (Offset?)

Re,

Désolé, un oubli, corrigez ainsi :

For Each col In Sh.Range("I2", Sh.Range("I2").End(xlToRight)).Resize(26).[COLOR="Red"]Columns[/COLOR]

Edit : mais comme on copie plusieurs feuilles, chaque série de copies va écraser la précédente...

Peut-être faut-il supprimer la ligne i = 0...

A+