Macro VBA / copier coller entre classeur avec individus variants
Résolu
YLRV
Messages postés
3
Date d'inscription
Statut
Membre
Dernière intervention
-
skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention -
skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'ai un petit soucis avec mon code VBA. J'ai plusieurs classeurs qui renseignent des listes d'individus. Le nombre d'individus est variable selon les classeurs. Je souhaiterai créer une macro dans mon programme principal me permettant de récupérer la liste des individus de tous les classeurs les uns après les autres. Mon fichier s'appelle Collage.xlsm et les fichiers sources s'appellent liste1, liste2 ...
Mon code marche pour copier coller des plages de données statiques. Seulement, le problème intervient du fait que le nombre d'individus varie selon les classeurs sources.
Est-il possible pour la partie du code suivante ... :
"
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1:$C$1"
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.[A1:C1] = "=Plage"
.[A1:C1].Copy 'Copie A1:C1
"
... Les parties inscrites en gras soient "dynamiques", j'entends, qu'elle puisse s'étendre selon le nombre d'individus dans le classeur actif.
J'espère avoir été suffisamment clair et reste à votre disposition pour plus de détail si nécessaire.
Voici mon code complet :
Option Explicit
Sub Import()
'Déclarations des variables
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte
Dim Ligne As Byte
Dim c1 As Workbook
Dim f1 As Worksheet
Dim fin1 As Integer
'Attributions
Set f1 = Worksheets("Feuil1")
Colonne = 0
Ligne = 1
'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
Worksheets("Feuil1").Cells.ClearContents ' Efface le contenu de la feuille qui va recevoir les données
Worksheets("Feuil2").Cells.ClearContents ' Efface le contenu de la feuille qui va recevoir les données
'Chemin = répertoire choisi
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'Choix du 1er fichier
fichier = Dir(Chemin & "*.xlsx*")
'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...
'on boucle sur tous les fichiers excel du répertoire choisi
If fichier <> ThisWorkbook.Name Then
'attribue un nom dans le classeur, se référant à la plage à importer : A1:C1
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1:$C$1"
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.[A1:C1] = "=Plage"
.[A1:C1].Copy 'Copie A1:C1
End With
With Sheets("Feuil1")
.Cells(1, 1).PasteSpecial xlPasteValues 'Colle A1:C1
End With
End If
Do While Len(fichier) > 0
fin1 = f1.Range("A" & Rows.Count).End(xlUp).Row
fin1 = fin1 + 1
If fichier <> ThisWorkbook.Name Then
'attribue un nom dans le classeur, se référant à la plage à importer : A2:C4
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$2:$C$10"
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.[A2:C10] = "=Plage"
.[A2:C10].Copy 'Copie A1:C1
End With
With Sheets("Feuil1")
.Cells(fin1, 1).PasteSpecial xlPasteValues 'Colle A2:C4
End With
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.[A2:C10] = "=Plage"
.[A2:C10].Copy 'Copie A1:C1
End With
With Sheets("Feuil1")
.Cells(fin1, 1).PasteSpecial xlPasteValues 'Colle A2:C4
End With
End If
fichier = Dir()
Loop
End If
End Sub
J'ai un petit soucis avec mon code VBA. J'ai plusieurs classeurs qui renseignent des listes d'individus. Le nombre d'individus est variable selon les classeurs. Je souhaiterai créer une macro dans mon programme principal me permettant de récupérer la liste des individus de tous les classeurs les uns après les autres. Mon fichier s'appelle Collage.xlsm et les fichiers sources s'appellent liste1, liste2 ...
Mon code marche pour copier coller des plages de données statiques. Seulement, le problème intervient du fait que le nombre d'individus varie selon les classeurs sources.
Est-il possible pour la partie du code suivante ... :
"
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1:$C$1"
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.[A1:C1] = "=Plage"
.[A1:C1].Copy 'Copie A1:C1
"
... Les parties inscrites en gras soient "dynamiques", j'entends, qu'elle puisse s'étendre selon le nombre d'individus dans le classeur actif.
J'espère avoir été suffisamment clair et reste à votre disposition pour plus de détail si nécessaire.
Voici mon code complet :
Option Explicit
Sub Import()
'Déclarations des variables
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte
Dim Ligne As Byte
Dim c1 As Workbook
Dim f1 As Worksheet
Dim fin1 As Integer
'Attributions
Set f1 = Worksheets("Feuil1")
Colonne = 0
Ligne = 1
'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
Worksheets("Feuil1").Cells.ClearContents ' Efface le contenu de la feuille qui va recevoir les données
Worksheets("Feuil2").Cells.ClearContents ' Efface le contenu de la feuille qui va recevoir les données
'Chemin = répertoire choisi
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'Choix du 1er fichier
fichier = Dir(Chemin & "*.xlsx*")
'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...
'on boucle sur tous les fichiers excel du répertoire choisi
If fichier <> ThisWorkbook.Name Then
'attribue un nom dans le classeur, se référant à la plage à importer : A1:C1
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1:$C$1"
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.[A1:C1] = "=Plage"
.[A1:C1].Copy 'Copie A1:C1
End With
With Sheets("Feuil1")
.Cells(1, 1).PasteSpecial xlPasteValues 'Colle A1:C1
End With
End If
Do While Len(fichier) > 0
fin1 = f1.Range("A" & Rows.Count).End(xlUp).Row
fin1 = fin1 + 1
If fichier <> ThisWorkbook.Name Then
'attribue un nom dans le classeur, se référant à la plage à importer : A2:C4
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$2:$C$10"
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.[A2:C10] = "=Plage"
.[A2:C10].Copy 'Copie A1:C1
End With
With Sheets("Feuil1")
.Cells(fin1, 1).PasteSpecial xlPasteValues 'Colle A2:C4
End With
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.[A2:C10] = "=Plage"
.[A2:C10].Copy 'Copie A1:C1
End With
With Sheets("Feuil1")
.Cells(fin1, 1).PasteSpecial xlPasteValues 'Colle A2:C4
End With
End If
fichier = Dir()
Loop
End If
End Sub
A voir également:
- Macro VBA / copier coller entre classeur avec individus variants
- Historique copier coller - Guide
- Copier coller pdf - Guide
- Copier-coller - Accueil - Informatique
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Style d'écriture a copier coller - Guide
1 réponse
J'ai deux manière de faire pour ton problème.
Soit
Tu désigne la plage comme ceci :
Mais il doit toujours y avoir une valeur dans la collonne A (et ça ne doit pas être une formule // enfin une formule peux poser problème)
Et il ne doit pas y avoir de lignes vides.
Soit
Tu définis une plage variable avec la formule DECALER() Dans chaque classeur si tu veux plus de détails je t'explique
Soit
Tu désigne la plage comme ceci :
Dim Ligne as integer
Ligne = 1
Do Sheets("Feuille 1").Cells(Ligne, 1) <> ""
Ligne = Ligne + 1
Loop
Range(Cells(1,1), Cells(Ligne, 3) = "=Plage"
Range(Cells(1,1), Cells(Ligne, 3).Copy 'Copie A1:CX
Mais il doit toujours y avoir une valeur dans la collonne A (et ça ne doit pas être une formule // enfin une formule peux poser problème)
Et il ne doit pas y avoir de lignes vides.
Soit
Tu définis une plage variable avec la formule DECALER() Dans chaque classeur si tu veux plus de détails je t'explique
J'ai cependant du mal à comprendre comment intégrer ta solution même si elle a l'air tout à fait logique.
Pour cette partie :
"
Do Sheets("Feuille 1").Cells(Ligne, 1) <> ""
Ligne = Ligne + 1
Loop
Range(Cells(1,1), Cells(Ligne, 3) = "=Plage"
Range(Cells(1,1), Cells(Ligne, 3).Copy 'Copie A1:CX
"
Est ce que la "feuille1" concernée ici correspond aux feuilles sources , c'est-à-dire, mes listes ou bien la "feuille1" de mon programme principal ?
Je n'arrive pas bien à comprendre comment intégrer ton code au mien.
correspond à
/////
sert à savoir le nombre de ligne remplies.
//////
En gros si je fait ça très rapidement :
sans avoir vraiment bien vérifier. Essaye de vois si tu comprend mieux maintenant
Merci beaucoup pour ton aide ;)
Si ça amrche tu peux mettre le sujet comme résolu :)