VBA Code copier ligne et coller dans un autre classeur

Bonjour à tous !

J'ai essayé d'écrire un code VBA qui: balaye un dossier rempli de fichiers excel, rentre dans chacun de ces fichiers, copie les lignes tant qu'elles ont du contenu, et les colle dans un autre classeur au bon endroit. Ce bon endroit dans cet autre classeur, je l'identifie par le fait que la première cellule de la ligne que je copie, doit être identique à la première cellule de la ligne sur laquelle je vais coller.

Le code est le 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 Temp 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
    ChargerFichier = 0

    While Not Fin

        If (Trim(TargetSheet.Cells(i, 1).Value) = "") Then
            Fin = True
        Else: trouve = True
        End If

        If (trouve) Then
            Liste.Rows(i).Select
            Selection.Copy

               While Not Fin2

                    If Trim(TargetSheet.Cells(i, 1).Value) = Trim(MainSheet.Cells(i, 1).Value) Then
                        ThisWorkbook.Sheets("Data").Rows(i).PasteSpecial
                        Fin2 = True
                    Else: i = i + 1

               Wend

            trouve = False
        End If

    Wend
    WB_Fichier.Close savechanges:=False

End Function

Le souci que je rencontre quand je tente d’exécuter mon code est le suivant: "Wend sans While", et la ligne surlignée est celle surlignée dans le code. Pourtant j'ai deux boucles While Not qui ont bien un Wend chacune. Le problème est peut-être que je ne peux pas imbriquer deux boucles de ce style. Est-ce ceci ?

Je n'arrive donc pas à passer outre ce problème, mais je pense aussi que ce n'est pas le dernier de mes problèmes. Quelqu'un pourrait-il me donner un coup de main pour modifier mon code et le rendre fonctionnel ?

Je remercie ceux qui prendront le temps de me lire, et je vous souhaite à tous un bon week-end.

À bientôt,

SkillzZ

PS: le balayage des différents fichiers situés dans mon répertoire fonctionne très bien, et l'identification des lignes à copier dans chacun des fichiers aussi, il me semble. Les soucis apparaissent à partir du While Not Fin2.

Bonjour,

dans Function ChargerFichier, il manque un End IF sur la boucle suivante

           If Trim(TargetSheet.Cells(i, 1).Value) = Trim(MainSheet.Cells(i, 1).Value) Then
                        ThisWorkbook.Sheets("Data").Rows(i).PasteSpecial
                        Fin2 = True
                    Else: i = i + 1

Hello SabV !

Bien vu, désolé pour la question bête du coup ! --'. L'erreur sur le while m'a mis des erreurs vis à vis des autres procédures/boucles ! Je vais voir ce que je peux faire en résolvant ce souci, il y a possibilité que je revienne si je bloque vraiment ! Merci beaucoup ! Bon week-end

SkillzZ

Re SabV,

si tu en as le temps et l'envie, j'aurais besoin de ton aide sur ce code. J'y ai corrigé plusieurs choses mais il ne fonctionne pas correctement:

Code: Tout sélectionner

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 tu peux voir dans mon code pour essayer de contourner ce problème mais ça ne fonctionne pas.

Je te 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 tu me donnes un coup de main, car là je bloque et suis à cours d'idée.

Je te souhaite un bon week-end,

SkillzZ

Je m'en suis finalement sorti SabV ! Ne perds donc pas de temps avec mon souci ! Merci encore !