Mettre un ensemble de classeur sur un seul document

Pauline44 · 21 Octobre 2015

Bonjour,

Je voudrais créer un classeur qui vient récupérer les colonnes A1:B50 de 50 autres classeurs.
Je voudrais mettre toutes ces données se copient à la suite.
Ainsi je colle sur A1:B50 ce que je viens récupérer sur le premier classeur ensuite je colle sur A51:B101 ce que je viens de récupérer sur le deuxième classeur puis je colle sur A102:B152 pour le troisième et ainsi de suite.
C'est à dire une seul feuille qui vient compiler toutes les feuilles de tous les autres classeurs.
Je n'arrive pas à coller à la suite. Pouvez vous m'aider.
Voici mon programme :

Sub Menu1()
'Copie du 1ER classeur
On Error Resume Next
ChDir ThisWorkbook.Path
'Workbooks.Open Filename:=Application.GetOpenFilename("Excel Files (*.xls),*.xls")
Application.DisplayAlerts = False
If Not Application.Dialogs(xlDialogOpen).Show Then Exit Sub 'Permet d'ouvrir un classeur dont je ne connais pas le nom
Dim Wbk As Workbook
Set Wbk = ActiveWorkbook
Dim Feuille As Worksheet
Dim AA() As String
Dim i As Integer
i = 0
For Each Feuille In Wbk.Sheets
ReDim Preserve AA(i)
AA(i) = Feuille.Name
Wbk.Sheets(AA(i)).Select
Range("A1:B50").Copy
Workbooks("Classeur1.xlsm").Worksheets("feuil1").Range("A1").PasteSpecial Paste:=xlPasteAll
Next Feuille
Wbk.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Worksheets("feul1").Range("AA1") = 1 / c'est là que je bloque, je voudrais mettre que si AA1 = 1 alors copier sur A51 à B101, puis si AA1 = 2 mettre sur A102:B152 etc...
End Sub

Merci pour votre aide
Cordialement,
Pauline

Nairolf · 21 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Salut,

En faisant quelques modifications dans le code, ça devrait fonctionner (je n'ai pas testé, donc il peut y avoir de petites erreurs):

Code:

Sub Menu1()

dim j as integer
j=0
 
While encore=true

'Copie du 1ER classeur
 On Error Resume Next
 ChDir ThisWorkbook.Path
 'Workbooks.Open Filename:=Application.GetOpenFilename("Excel Files (*.xls),*.xls")
 Application.DisplayAlerts = False
 If Not Application.Dialogs(xlDialogOpen).Show Then Exit Sub 'Permet d'ouvrir un classeur dont je ne connais pas le nom
 Dim Wbk As Workbook
 Set Wbk = ActiveWorkbook
 Dim Feuille As Worksheet
 Dim AA() As String
 Dim i As Integer
 i = 0
 For Each Feuille In Wbk.Sheets

'je ne comprends pas l'utilisation de AA(i)

' ReDim Preserve AA(i)
' AA(i) = Feuille.Name
' Wbk.Sheets(AA(i)).Select

Wbk.Sheets(Feuille).Select 'ou Feuille.Select 'je ne sais plus lequel marche

dim k as integer

k=50*i+j

 Range("A1:B50").Copy
 Workbooks("Classeur1.xlsm").Worksheets("feuil1").R ange("A" & k + 1).PasteSpecial Paste:=xlPasteAll 'modifié
 Next Feuille
 Wbk.Close savechanges:=False
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
' Worksheets("feul1").Range("AA1") = 1 / c'est là que je bloque, je voudrais mettre que si AA1 = 1 alors copier sur A51 à B101, puis si AA1 = 2 mettre sur A102:B152 etc...' retiré car plus besoin


Response = MsgBox("un autre classeur", vbYesNo, "encore ?")
If Response = vbYes Then    ' L'utilisateur a choisi Oui.
    encore = true
Else    ' L'utilisateur a choisi Non.
    encore = false
End If

j=k+50
wend

 End Sub

Paf · 21 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Bonjour

à tester :

remplacer cette partie de code

Code:

For Each Feuille In Wbk.Sheets
ReDim Preserve AA(i)
AA(i) = Feuille.Name
Wbk.Sheets(AA(i)).Select
Range("A1:B50").Copy
Workbooks("Classeur1.xlsm").Worksheets("feuil1").R ange("A1").PasteSpecial Paste:=xlPasteAll
Next Feuille

par

Code:

With Workbooks("Classeur1.xlsm").Worksheets("feuil1")
For Each Feuille In Wbk.Sheets 
    DerL=.Range("A" & .Rows.Count).End(xlUp).Row+1
    Wbk.Sheets(Feuille.Name)Range("A1:B50").Copy  .Range("A" & DerL)
Next Feuille
End With

la ligne Worksheets("feul1").Range("AA1") = 1 ... pourra être supprimée puisque non nécessaire pour déterminer l'emplacement de la copie.

Je ne sais pas s'il y a confusion entre Feuille et Classeur ou si je n'ai pas compris, car on ne trouve pas trace d'ouverture de plusieurs classeurs ?

A+

Edit : bonjour Nairolf

Pauline44 · 23 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Bonjour,

Merci pour vos réponses,
Paf, effectivement, je voudrais copier plusieurs classeurs, chacun avec un nom différent.
Est ce possible sans les ouvrir un par un?
Merci,

A+

Paf · 23 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Re,

si tous les classeurs, et uniquement ceux à traiter, sont dans un même répertoire pas de soucis; si non, c'est faisable mais un peu plus galère.

A+

Pauline44 · 23 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Paf,

Oui, ils sont tous dans le même dossier.
Pouvez vous me communiquer le code?
Svp......

Merci

Paf · 23 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

re,

si j'ai tout bien compris, a priori:

Code:

Sub Menu1()
'Copie des classeurs

 Application.ScreenUpdating = false
 Application.DisplayAlerts = False
 Dim Wbk As Workbook
 Set Wbk = ThisWorkbook ' le classeur qu lance la macro et qui reçoit les copies
 Dim Feuille As Worksheet
 Dim i As Integer

 Chemin = Wbk.Path & "\"   ' à adapter .Définit le chemin d'accès aux fichiers.
 NomFic = Dir(Chemin & "*.xls*")    ' prend le premier fichier parmi les fichiers xls,xlsx,xlsm ...

 Do While NomFic <> ""    ' Commence la boucle.
    Workbooks.Open Filename:=Chemin & NomFic

    With Wbk.Worksheets("feuil1")
    For Each Feuille In ActiveWorkbook.Worksheets
        DerL=.Range("A" & .Rows.Count).End(xlUp).Row+1
        Feuille.Range("A1:B50").Copy  .Range("A" & DerL) 'pas sûr que ça marche
    Next Feuille
    End With

   Workbooks(NomFic).Close savechanges:=False

   NomFic = Dir    ' prend le fichier suivant 
 Loop

 Application.DisplayAlerts = True
 Application.ScreenUpdating = True

End Sub

non testé

A+

Pauline44 · 27 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Bonjour,

Merci pour ta formule!
Mais cette partie ne fonctionne pas :

For Each Feuille In ActiveWorkbook.Worksheets
DerL=.Range("A" & .Rows.Count).End(xlUp).Row+1
Feuille.Range("A1:B50").Copy .Range("A" & DerL) 'pas sûr que ça marche
Next Feuille

Rien ne ce copie dans mon classeur
Avez vous une solution?

Merci,

Cordialement,

Pauline

Paf · 27 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Re,

le code est prévu pour être lancé depuis le classeur qui va recevoir les copies de toutes les feuilles des classeurs *.xls* qui se trouvent dans le même répertoire que le classeur 'lanceur'. Est ce bien la bonne configuration ?

si non il faut modifier le chemin d'accès à ces classeurs dans la ligne de code

Chemin = Wbk.Path & "\" ' à adapter .Définit le chemin d'accès aux fichiers.

A+

Pauline44 · 28 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Bonjour,

Voici le code que j'ai rentré :

Sub Menu1()
'Copie des classeurs

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim chemin As String
Dim NomFic As String
Dim Wbk As Workbook
Set Wbk = ThisWorkbook ' le classeur qu lance la macro et qui reçoit les copies
Dim Feuille As Worksheet
Dim i As Integer

chemin = ThisWorkbook.Path '& "R:\NAV\T1MN00008\6.ETD\619.Travail\CAZIER Olivier\Bases\JSM DRD ACR\Importés" ' à adapter .Définit le chemin d'accès aux fichiers.
NomFic = Dir(chemin & "*.xls*") ' prend le premier fichier parmi les fichiers xls,xlsx,xlsm ...

Do While NomFic <> "" ' Commence la boucle.
Workbooks.Open Filename:=chemin & NomFic

With Wbk.Worksheets("feuil1")
For Each Feuille In ActiveWorkbook.Worksheets
DerL = .Range("A" & .Rows.Count).End(xlUp).Row + 1
Feuille.Range("AB1:AF200").Copy .Range("A" & DerL) 'pas sûr que ça marche
Next Feuille
End With

Workbooks(NomFic).Close savechanges:=False

NomFic = Dir ' prend le fichier suivant
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Le classeur ou je veux récupérer tous les autres classeurs est rangé dans le même dossier.
Lorsque je décompose le code j'ai :
chemin ="R:\...."
En revanche sur la ligne de commande NomFic = Dir(chemin & "*.xls*")
J'ai NomFic = ""
A mon avis, c'est là ou est l'erreur.

Merci d'avance,

Paf · 28 Octobre 2015

Re : Mettre un ensemble de classeur sur un seul document

Re,

Voir post #7 et #9 : Chemin = Wbk.Path & "\"

Bonne suite

Pauline44 · 2 Novembre 2015

Re : Mettre un ensemble de classeur sur un seul document

Bonjour,

Effectivement, c'est ce que j'avais fais dans un premier temps.
Or il me met une erreur d'execution 52 : "nom ou numéro de fichier incorrect"
lors du débogage je vois que :
Chemin est bien égal à R:\NAV\T1MN00008\6.ETD\619.Travail\CAZIER Olivier\Bases\JSM DRD ACR\Importés
Et que NomFic =""

Merci pour ton temps,

Cordialement,

Pauline

Pauline44 · 10 Novembre 2015

Re : Mettre un ensemble de classeur sur un seul document

Bonjour,

Avez vous une solution?
Je n'arrive toujours pas à lancer mon programme suite à l'erreur évoqué ci dessus.
Merci d'avance,

Cdlt,

Pauline

Effectuez une recherche sur Excel Downloads...

Mettre un ensemble de classeur sur un seul document

Pauline44

XLDnaute Nouveau

Nairolf

XLDnaute Accro

Paf

XLDnaute Barbatruc

Pauline44

XLDnaute Nouveau

Paf

XLDnaute Barbatruc

Pauline44

XLDnaute Nouveau

Paf

XLDnaute Barbatruc

Pauline44

XLDnaute Nouveau

Paf

XLDnaute Barbatruc

Pauline44

XLDnaute Nouveau

Paf

XLDnaute Barbatruc

Pauline44

XLDnaute Nouveau

Pauline44

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums