VBA - Code copier/coller ligne autre classeur au bon endroit
Bonjour à tous,
j'ai besoin de faire fonctionner un code, qui a pour but de parcourir un répertoire de fichier, de s'introduire dans chaque fichier, et d'aller copier chacune des lignes d'un tableau, et de les coller dans un fichier global, au bon endroit. Ce bon endroit est identifié par le contenu identique d'une cellule entre la ligne copier et celle où l'on va coller.
J'ai élaboré le code suivant:
Sub Consolider_Click()
Dim S_Commande As Worksheet
Dim Chemin As String
Dim Extension As String
Dim Nb As Integer
Set S_Commande = ThisWorkbook.Sheets("Commande")
Chemin = S_Commande.Cells(3, 2).Value
Extension = S_Commande.Cells(4, 2).Value
Nb = BoucleFichiers(Chemin, Extension)
MsgBox ("Nombre de lignes remplies : " & Nb)
End Sub
Function BoucleFichiers(Chemin As String, Extension As String) As Integer
Dim Fichier As String
BoucleFichiers = 0
'Boucle sur tous les fichiers 'Extension' du répertoire 'Chemin'
Fichier = Dir(Chemin & "*" & Extension)
Do While Len(Fichier) > 0
'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
BoucleFichiers = BoucleFichiers + ChargerFichier(Chemin & Fichier)
'MsgBox (Chemin & Fichier) '<-- A modifier
Fichier = Dir()
Loop
End Function
Function ChargerFichier(NomFichier As String) As Integer
Dim WB_TargetFichier As Workbook
Dim TargetSheet As Worksheet
Dim MainSheet As Worksheet
Dim Fin As Boolean
Dim Fin2 As Boolean
Dim trouve As Boolean
Dim i As Integer
Dim j As Integer
Set WB_TargetFichier = Workbooks.Open(NomFichier)
Set TargetSheet = WB_TargetFichier.Sheets("Data")
Set MainSheet = ThisWorkbook.Sheets("Data")
Fin = False
trouve = False
i = 4
j = 4
ChargerFichier = 0
While Not Fin
If (Trim(TargetSheet.Cells(i, 2).Value) = "") Then
Fin = True
Else: trouve = True
End If
If (trouve) Then
TargetSheet.Rows(i).Select
Selection.Copy
While Not Fin2
If Trim(TargetSheet.Cells(i, 2).Value) = Trim(MainSheet.Cells(j, 2).Value) Then
MainSheet.Rows(i).PasteSpecial
Application.CutCopyMode = False
ChargerFichier = ChargerFichier + 1
Fin2 = True
Else: j = j + 1
End If
Wend
trouve = False
End If
i = i + 1
Wend
WB_TargetFichier.Close savechanges:=False
End Function
Quand j'éxécute mon code, je n'obtiens pas de message d'erreur, mais
1) il ne fonctionne pas correctement car il ne colle qu'une seul ligne et en plus au mauvais endroit puisqu'il me la colle dans la première ligne de mon tableau alors qu'elle devrait être ailleurs.
2) J'ai un message qui apparaît plusieurs fois lorsque la macro tourne, me demandant si je veux conserver ce qui se trouve dans le presse papier. J'ai essayé de rajouter la ligne Application.CutCopyMode = False que vous pouvez voir dans mon code pour essayer de contourner ce problème mais ça ne fonctionne pas.
Je vous joins le fichier global où j'aimerais coller les lignes au bon endroit, et deux fichiers exemple qui sont normalement situés dans un répertoire où la macro va aller pour les lire. Ce sont des versions simplifiées par rapport aux originaux qui contiennent bcp plus de lignes, et qui ont beaucoup plus de colonnes remplies.
J'apprécierai énormément que l'un d'entre vous me donne un coup de main, car là je bloque et suis à cours d'idée.
Je vous souhaite un bon week-end !
SkillzZ
Je m'en suis finalement sorti. Il fallait remplacer le i de MainSheet.Rows par un j et placer un Fin2 = False juste après la seconde boucle while wend afin de ne pas s'arrêter tant qu'on a pas parcouru toutes les lignes des fichiers cibles !