Probleme de colonne de destination copie dans une boucle

Question

D'abord bonjour à tous .

Je suis débutant en VBA et je fait appel à votre aide car je sèche sur une macro .

Le but de cette macro etait le suivant

1 ouvrir l'ensemble des fichiers d'un repertoire et copier les données de la colonne B de la 1ere feuille .

2 Copier ces données en colonnes qui se suivent dans un fichier compilation .

Or c'est sur ce second point que je cale . En effet, il me colle toutes les colonnes sur la meme colonne de destination alors que je souhaiterai qu'elle se decale à chaque boucle .

Voici mon code pour que vous puissiez y voir plus clair .

Sub copier_colonnes()

''' déclarations des variables globales '''

Dim fichierCompilation As Workbook 'fichier sur lequel on va compiler les données

Dim workbookCourant As Workbook 'workbook sur lequel on travaille

Dim repertoireCourant As String 'répertoire des fichiers à parcourir

Dim nomFichierCourant As String 'fichier courant

Dim numeroColonne As Integer 'numéro de la colone ou copier les éléments

Application.ScreenUpdating = False

Set fichierCompilation = ThisWorkbook

''' libellés du fichier de comppliation '''

Range("A1").Select

ActiveCell.Value = "Nom UFA"

Range("A4").Select

ActiveCell.Value = "Heures Présentielles"

Range("A5").Select

ActiveCell.Value = "Tutorat de projet"

Range("A6").Select

ActiveCell.Value = "Suivi en entreprise"

Range("A7").Select

ActiveCell.Value = "Responsabilité Pédagogique"

Range("A8").Select

ActiveCell.Value = "Innovation Pédagogique"

Range("A9").Select

ActiveCell.Value = "Forfait fonctionnement"

Range("A10").Select

ActiveCell.Value = "Mobilité colective internationale"

Range("A11").Select

ActiveCell.Value = "Droits d'inscription"

Range("A12").Select

ActiveCell.Value = "Contribution au salaire des APA"

Range("A14").Select

ActiveCell.Value = "Total UFA"

Range("A15").Select

ActiveCell.Value = "Coût UFA"

Range("A16").Select

ActiveCell.Value = "Valorisation etablissement"

repertoireCourant = "C:\budget 2015\UFA 1\" 'affecte la valeur "C:\budget 2015\UFA 1\" dans la variable "repertoireCourant"

nomFichierCourant = Dir(repertoireCourant & "*.xls*") 'affecte la valeur dans la variable "nomFichierCourant"

''' on fait la popote '''

Do While Len(nomFichierCourant) > 0

Set workbookCourant = Workbooks.Open(repertoireCourant & nomFichierCourant) 'on redéfinit le workbook courant

Sheets("Compil UFA").Select 'sélectionne la feuille "Compil UFA" dans ton workbook courant

'désactiver le filtre automatique de la feuille si activé

If ActiveSheet.AutoFilterMode = True Then

ActiveSheet.AutoFilterMode = False

End If

'sélectionner la plage b4 à b16

Range("B1:B16").Select

'copier la sélection

Selection.Copy

'changer de fichier (on retourne sur le fichier de compilation)

Windows("fichierCompilation.xlsm").Activate

'sélectionner la feuille nommée "Feuil1"

Sheets("Feuil1").Select

'sélectionner la plage

Range("a1").End(xlToRight).Offset(0, 2).Select 'on se déplace sur la dernire cellule à droite de A4 qui est non vide puis on se déplace encore d'un cran à droite et on sélectionne

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

workbookCourant.Close False 'Fermer le fichier temporairement ouvert

nomFichierCourant = Dir() 'on sélectionne le nom du fichier suivant dans le répertoire

Loop

Application.ScreenUpdating = True

End Sub

Je pense que je m'y prends mal car j'aimerai que la range de destination soit [B1;B16] et se decale à chaque boucle . ( les colonnes copiées ont toutes les memes dimensions ).

Dites moi si je n'ai pas été assez clair .

Dans tous les cas merci :

Banzai64 · Answer

Bonjour et bienvenu(e)

Essayes ceci

Le pourquoi c'est que tu te décaler de 2 colonnes et cela te faisait retomber toujours sur la même

Sub copier_colonnes()

''' déclarations des variables globales '''

Dim fichierCompilation As Workbook  'fichier sur lequel on va compiler les données

Dim workbookCourant As Workbook  'workbook sur lequel on travaille
Dim repertoireCourant As String  'répertoire des fichiers à parcourir
Dim nomFichierCourant As String  'fichier courant

Dim numeroColonne As Integer  'numéro de la colone ou copier les éléments

  Application.ScreenUpdating = False

  Set fichierCompilation = ThisWorkbook

  ''' libellés du fichier de comppliation '''
  Range("A1") = "Nom UFA"
  Range("A4") = "Heures Présentielles"
  Range("A5") = "Tutorat de projet"
  Range("A6") = "Suivi en entreprise"
  Range("A7") = "Responsabilité Pédagogique"
  Range("A8") = "Innovation Pédagogique"
  Range("A9") = "Forfait fonctionnement"
  Range("A10") = "Mobilité colective internationale"
  Range("A11") = "Droits d'inscription"
  Range("A12") = "Contribution au salaire des APA"
  Range("A14") = "Total UFA"
  Range("A15") = "Coût UFA"
  Range("A16") = "Valorisation etablissement"

  repertoireCourant = "C:\budget 2015\UFA 1\"  'affecte la valeur "C:\budget 2015\UFA 1\" dans la variable "repertoireCourant"

  nomFichierCourant = Dir(repertoireCourant & "*.xls*")  'affecte la valeur dans la variable "nomFichierCourant"

  ''' on fait la popote '''
  Do While Len(nomFichierCourant) > 0
    Set workbookCourant = Workbooks.Open(repertoireCourant & nomFichierCourant)  'on redéfinit le workbook courant

    Sheets("Compil UFA").Select  'sélectionne la feuille "Compil UFA" dans ton workbook courant

    'désactiver le filtre automatique de la feuille si activé
    If ActiveSheet.AutoFilterMode = True Then
      ActiveSheet.AutoFilterMode = False
    End If

    ' On copie la plage b4 à b16
    Range("B1:B16").Copy ThisWorkbook.Sheets("Feuil1").Range("A1").End(xlToRight).Offset(0, 1)

    workbookCourant.Close False  'Fermer le fichier temporairement ouvert
    nomFichierCourant = Dir()  'on sélectionne le nom du fichier suivant dans le répertoire
  Loop

  Application.ScreenUpdating = True

End Sub

ThauThème · Answer

Ton code et correctement écrit et devrait fonctionner mais sans fichier exemple difficile de te dire où se trouve l'erreur. Toutefois, deux choses m'interpellent : • tu déclares la variable : Dim fichierCompilation As Workbook et tu la définies avec : Set fichierCompilation = ThisWorkbook Ensuite, plus loin dans le code, tu rappelles le fichier avec : Windows("fichierCompilation.xlsm").Activate . Soit ta variable ne sert à rien et il faut supprimer déclaration et définition. Soit tu écris : fichierCompilation.Activate • Quand tu définis les libellés de ce fichier tu ne spécifies pas l'onglet comme tu le fais plus loin pour coller la colonne ( Sheets("Feuil1") ). Le problème ne serait-il pas ici ? En règle générale, il faut éviter les Select inutile que ne font que ralentir l'exécution du code. Ci-dessous le code réécrit en tenant compte des remarques : Sub copier_colonnes() ''' déclarations des variables globales ''' Dim fichierCompilation As Workbook 'fichier sur lequel on va compiler les données Dim workbookCourant As Workbook 'workbook sur lequel on travaille Dim repertoireCourant As String 'répertoire des fichiers à parcourir Dim nomFichierCourant As String 'fichier courant Dim O As Object 'déclare la variable O (Onglet) Application.ScreenUpdating = False Set fichierCompilation = ThisWorkbook Set O = fichierCompilation.Sheets("Feuil1") ''' libellés du fichier de compliation ''' O.Range("A1").Value = "Nom UFA" O.Range("A4").Value = "Heures Présentielles" O.Range("A5").Value = "Tutorat de projet" O.Range("A6").Value = "Suivi en entreprise" O.Range("A7").Value = "Responsabilité Pédagogique" O.Range("A8").Value = "Innovation Pédagogique" O.Range("A9").Value = "Forfait fonctionnement" O.Range("A10").Value = "Mobilité colective internationale" O.Range("A11").Value = "Droits d'inscription" O.Range("A12").Value = "Contribution au salaire des APA" O.Range("A14").Value = "Total UFA" O.Range("A15").Value = "Coût UFA" O.Range("A16").Value = "Valorisation etablissement" repertoireCourant = "C:\budget 2015\UFA 1\" 'affecte la valeur "C:\budget 2015\UFA 1\" dans la variable "repertoireCourant" nomFichierCourant = Dir(repertoireCourant &amp; "*.xls*") 'affecte la valeur dans la variable "nomFichierCourant" ''' on fait la popote ''' Do While Len(nomFichierCourant) &gt; 0 Set workbookCourant = Workbooks.Open(repertoireCourant &amp; nomFichierCourant) 'on redéfinit le workbook courant With workbookCourant.Sheets("Compil UFA") 'prend en comte la feuille "Compil UFA" dans ton workbook courant 'désactiver le filtre automatique de la feuille si activé If .AutoFilterMode = True Then .AutoFilterMode = False End If 'sélectionner la plage b4 à b16 .Range("B1:B16").Copy 'changer de fichier (on retourne sur le fichier de compilation) End With O.Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False workbookCourant.Close False 'Fermer le fichier temporairement ouvert nomFichierCourant = Dir() 'on sélectionne le nom du fichier suivant dans le répertoire Loop Application.ScreenUpdating = True End Sub &#91;Édition&#93; Bonjour Banzai, nos messages se sont croisés... Bien vu ! je navet pas vu ce point de détail qui résout le problème... Du coup j'ai modifié le code...

Banzai64 · Answer

Cela vient du fait que dans ta page tu n'as que la colonne A de remplie et la fonction End(XlToRight) n'est pas la plus adaptée dans ce cas Remplaces la ligne incriminée par celle-ci Range("B1:B16").Copy ThisWorkbook.Sheets("Feuil1").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) Avec celle ci il ne faut pas de données sur la ligne 1 après la dernière colonne...