Mettre un ensemble de classeur sur un seul document

P

Pauline44

XLDnaute Nouveau
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
 
Trier par date Trier par votes
N

Nairolf

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif
P

Pauline44

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif
P

Pauline44

XLDnaute Nouveau
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,
 
Vote positif 0 Vote négatif
P

Pauline44

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
Microsoft 365 TCD VBA SELECTION PLUSIEUR VALEUR
Réponses
3
Affichages
623
merinos
merinos
C
  • Question
XL 2016 envoie de feuille excel sur outlook depuis un classeur
Réponses
2
Affichages
369
chac10
C
cathodique
  • Résolu(e)
XL 2010 Mauvaise utilisation de la fonction InStr
Réponses
11
Affichages
582
jurassic pork
jurassic pork
Y
  • Question
Microsoft 365 récupérer données de tableau structuré sur une plage
Réponses
2
Affichages
481
jpb388
jpb388
Y
  • Résolu(e)
XL 2021 Macro pour imprimer un document
Réponses
2
Affichages
769
Yoan_VBA
Y
F
  • Question
Power Query Compiler des donner de plusieurs tableaux sur un seul (automatiquement)
Réponses
6
Affichages
631
Fëa
F
C
  • Résolu(e)
XL 2019 Copier et renommer (en même temps) des feuilles à partir d'une liste de noms dans un colonne
Réponses
13
Affichages
1 K
Clemee61
C
O
  • Question
Microsoft 365 Excel [VBA]. Erreur d’exécution 424 Objet requis sur une concaténation
Réponses
3
Affichages
351
Oneida
Oneida
M
  • Résolu(e)
Microsoft 365 VBA - RECHERCHEV multiples dans un autre classeur sélectionné
Réponses
1
Affichages
582
M4x1m3
M
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
411
guiyom
G

Membres actuellement en ligne

16 membres et 104 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 651
Messages
2 111 544
Membres
111 199
dernier inscrit
mavoungou regis