Macro VBA / Copier Coller entre Classeurs
jo9721
Messages postés
4
Date d'inscription
Statut
Membre
Dernière intervention
-
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Copier coller vba excel entre 2 classeurs
- Historique copier coller - Guide
- Supercopier 2 - Télécharger - Gestion de fichiers
- Liste déroulante excel - Guide
- Copier coller pdf - Guide
- Copier-coller - Accueil - Informatique
2 réponses
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
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
