Macro VBA / Copier Coller entre Classeurs
Fermé
jo9721
Messages postés
4
Date d'inscription
samedi 24 avril 2010
Statut
Membre
Dernière intervention
18 avril 2016
-
Modifié par jo9721 le 18/04/2016 à 07:46
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 - 20 avril 2016 à 09:28
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 - 20 avril 2016 à 09:28
A voir également:
- Copier coller vba excel entre 2 classeurs
- Dessin sms copier coller zizi ✓ - Forum Réseaux sociaux
- Liste déroulante excel - Guide
- Copier coller pdf - Guide
- Formule excel - Guide
- Copier une vidéo youtube - Guide
2 réponses
jo9721
Messages postés
4
Date d'inscription
samedi 24 avril 2010
Statut
Membre
Dernière intervention
18 avril 2016
18 avril 2016 à 12:22
18 avril 2016 à 12:22
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
