Macro VBA / copier coller entre classeur avec individus variants

Résolu/Fermé
YLRV Messages postés 3 Date d'inscription mercredi 14 mai 2014 Statut Membre Dernière intervention 16 mai 2014 - 14 mai 2014 à 11:25
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 - 16 mai 2014 à 11:02
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

A voir également:

1 réponse

skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 54
14 mai 2014 à 11:39
J'ai deux manière de faire pour ton problème.

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
1
YLRV Messages postés 3 Date d'inscription mercredi 14 mai 2014 Statut Membre Dernière intervention 16 mai 2014
14 mai 2014 à 15:36
Merci pour ta réponse très rapide.

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.
0
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 54
15 mai 2014 à 08:58
Actuellement je te donnais pas la solution mais juste un exemple de syntaxe pour être plus précis dans ta selection .

Range(Cells(1,1), Cells(Ligne, 3) = "=Plage" 
Range(Cells(1,1), Cells(Ligne, 3).Copy 'Copie A1:CX

correspond à

.[A1:C1] = "=Plage" 
.[A1:C1].Copy 'Copie A1:C1

/////

Dim Ligne as integer
Ligne = 1
Do Sheets("Feuille 1").Cells(Ligne, 1) <> ""Ligne = Ligne + 1
Loop

sert à savoir le nombre de ligne remplies.

//////

En gros si je fait ça très rapidement :

If fichier <> ThisWorkbook.Name Then 
Dim Ligne as integer
Ligne = 1
Do
Sheets("Feuille 1").Cells(Ligne, 1) <> ""
Ligne = Ligne + 1
Loop

'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$"& Ligne
With Sheets("Feuil2")
' "Importe les données" grâce au nom donné ci-dessus
.Range(Cells(1,1), Cells(Ligne, 3) = "=Plage"
.Range(Cells(1,1), Cells(Ligne, 3).Copy 'Copie A1:CX
End With
With Sheets("Feuil1")
.Cells(1, 1).PasteSpecial xlPasteValues 'Colle A1:C1
End With
End If

sans avoir vraiment bien vérifier. Essaye de vois si tu comprend mieux maintenant
0
YLRV Messages postés 3 Date d'inscription mercredi 14 mai 2014 Statut Membre Dernière intervention 16 mai 2014
16 mai 2014 à 09:52
Super!
Merci beaucoup pour ton aide ;)
0
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 54
16 mai 2014 à 11:02
Apparement tu as comrpis ?

Si ça amrche tu peux mettre le sujet comme résolu :)
0