Macro VBA / Copier Coller entre Classeurs Fermé

Question

Bonjour, 

Voilà j'ai quelques notions en VBA mais elles remontent à longtemps et j'ai actuellement quelques problèmes pour mettre à jour une macro afin de l'adapter à mes besoins et j'aurais besoin de votre aide svp. (cf ce code :  https://forums.commentcamarche.net/forum/affich-27563338-macro-excel-vba-et-copier-coller-entre-classeur )

J'ai plusieurs fichiers excel dans un dossier et je souhaiterai faire un récapitulatif de ces fichiers dans un autre classeur excel. Sachant que chaque donnée sera toujours à la même place dans les différents classeurs.

J'aimerai récupérer dans chaque classeur les cases suivantes : C2, A2 , B3, B4, B8, G8, B9 et B11

Il faudrait qu'elles soient copier en ligne dans l'ordre qui suit et à la suite pour chacun des classeurs. 
Exemple dans le classeur récapitulatif:

- - - - - - -  A - B - C - D - E - F - G - H
Classeur 1 : B3  C2  B4   B8  B9  B11  G8   A2
Classeur 2 : B3  C2  B4   B8  B9  B11  G8   A2
Etc. 

Si vous pouviez m'aider je vous en serai très reconnaissant ! Sachant qu'à défaut d'un code complet j'accepterai volontiers la démarche à suivre pour modifier le premier code.

En vous remerciant,
Jonathan

jo9721 · Answer

Edit : Alors j'ai trouvé comment agencé tout ça mais je suis confronter à un autre soucis, certains classeurs excels ont un léger décalage dans certains cas et je souhaiterai inclure dans la maco une reconnaissance de ce décalage par un mot clef qui se trouve dans certaines cellules afin de réaménager la suite du code selon le cas.

Option Explicit

Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte
Dim DCL As Byte

    'ouverture de la fenêtre de choix du répertoire
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
    'message
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else 'sinon
    'Chemin = répertoire choisi

    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    'Choix du 1er fichier
    fichier = Dir(Chemin & "*.xls*")
    'Colonne = n° de colonne ou on va coller les données
        'pour commencer colonne A, laisser à 0, pour commencer colonne B remplacer 0 par 1 etc...
    Colonne = 1
    'on boucle sur tous les fichiers excel du répertoire choisi
    Do While Len(fichier) > 0
        Colonne = Colonne + 1
        If fichier <> ThisWorkbook.Name Then
            'attribue un nom dans le classeur, se référant à la plage à importer : A2:I18
            ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]infos'!$A$1:$G$20"
            With Sheets("Feuil2")
                ' "Importe les données" grâce au nom donné ci-dessus
                 .[A1:G20] = "=Plage"
            End With

            With Sheets("Feuil2")
                .Cells(2 + DCL, 3).Copy 'Copie C2
            End With
            With Sheets("Feuil1")
                .Cells(Colonne, 1).PasteSpecial xlPasteValues 'Colle C2
            End With
            With Sheets("Feuil2")
                .Cells(3 + DCL, 2).Copy 'Copie B3
            End With
            With Sheets("Feuil1")
               .Cells(Colonne, 2).PasteSpecial xlPasteValues 'Colle B3
            End With
            With Sheets("Feuil2")
                .Cells(8 + DCL, 2).Copy 'copie B8
            End With
            With Sheets("Feuil1")
               .Cells(Colonne, 3).PasteSpecial xlPasteValues 'Colle B8
            End With
            With Sheets("Feuil2")
                .Cells(9 + DCL, 2).Copy 'Copie B9
            End With
            With Sheets("Feuil1")
               .Cells(Colonne, 4).PasteSpecial xlPasteValues 'Colle B9
            End With
            With Sheets("Feuil2")
                .Cells(11 + DCL, 2).Copy  'Copie B11
            End With
            With Sheets("Feuil1")
               .Cells(Colonne, 5).PasteSpecial xlPasteValues 'Colle B11
            End With
            With Sheets("Feuil2")
                .Cells(8 + DCL, 7).Copy 'Copie G8
            End With
            With Sheets("Feuil1")
               .Cells(Colonne, 6).PasteSpecial xlPasteValues 'Colle G8
            End With
        
        End If
        fichier = Dir()
    Loop
End If
End Sub

f894009 · Answer

Bonjour,

Differences entre ce que vous voulez et ce que vous avez code !!!
Colonne---->ligne

                '------------------1   2    3    4   5    6   7    8
                '- - - - - - ------ A - B - C - D - E - F - G - H
                'Classeur 1 : B3 C2 B4 B8 B9 B11 G8 A2
                'Classeur 2 : B3 C2 B4 B8 B9 B11 G8 A2
                With Sheets("Feuil1")
                    .Cells(Colonne, 1) = Sheets("Feuil2").Cells(2 + DCL, 3)      'Copie C2
                    .Cells(Colonne, 2) = Sheets("Feuil2").Cells(3 + DCL, 2)      'Copie B3
                    .Cells(Colonne, 3) = Sheets("Feuil2").Cells(8 + DCL, 2)      'copie B8
                    .Cells(Colonne, 4) = Sheets("Feuil2").Cells(9 + DCL, 2)      'Copie B9
                    .Cells(Colonne, 5) = Sheets("Feuil2").Cells(11 + DCL, 2)    'Copie B11
                    .Cells(Colonne, 6) = Sheets("Feuil2").Cells(8 + DCL, 7)      'Copie G8
                    '.Cells(Colonne, 6) = Sheets("Feuil2").Cells(8 + DCL, 7)      'Copie G8
                    '.Cells(Colonne, 6) = Sheets("Feuil2").Cells(8 + DCL, 7)      'Copie G8
                End With


un mot clef qui se trouve dans certaines cellules
Pas facile a programmer ce truc!!!

Macro VBA / Copier Coller entre Classeurs

2 réponses

Discussions similaires