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

37fichierglobal.xlsm (460.67 Ko)
24fichier-exemple1.xlsx (326.46 Ko)
25fichier-exemple2.xlsx (326.51 Ko)

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 !

Rechercher des sujets similaires à "vba code copier coller ligne classeur bon endroit"