Copier dans une feuille d'un classeur les premieres feuilles de tous les classeu

bjr

essaie avec ceci, il faut adapter les noms !!


' récupèrer les premières feuilles des classeurs d'un dossier pour créer une feuille contenant les feuilles

Sub RecupFeuillesEn1(dossier)
'' Dossier = chemin d'accès aux fichiers
Dim i%, wbk As Workbook, Tmp As Workbook

On Error Resume Next 'pour éviter une éventuelle faute de frappe
If (GetAttr(dossier) And vbDirectory) = False Then
MsgBox "Le dossier " & dossier & " n'existe pas"
Exit Sub
End If

Set wbk = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = dossier
'.SearchSubFolders = True 'scanne les sous dossiers
'.FileType = msoFileTypeExcelWorkbooks 'cherche les .xls
.Filename = "*.xls"
If .Execute > 0 Then

For i = 1 To .FoundFiles.Count
'ouvre les classeurs trouvés
Set Tmp = Workbooks.Open(.FoundFiles(i))
'copie la plage utilisée de la feuille 1
Tmp.Sheets(1).UsedRange.Copy

' on se place sur la 1ere ligne vide de la feuille cible

wbk.Sheets("Liste").Activate
' Liste= feuille cible
Range("a1").Select
Range("A65536").End(xlUp).Select
If i > 1 Then ActiveCell.Offset(1, 0).Select ' on descent d'une ligne
LigneASupp = ActiveCell.Row
'la colle dans le classeur en cours
wbk.Sheets("Liste").Paste
' If i > 1 Then Rows(LigneASupp).Delete
' cette ligne ci dessus efface les entetes de colonne le cas echeant !!
'vide le presse-papiers
Application.CutCopyMode = False
'ferme le classeur copié
Tmp.Close False

Next i
End If
End With

'enregistrement et fermeture
wbk.Save 'As dossier & "\Sommaire"
' wbk.Close
Range("a1").Select

End Sub

il te faut quand même etudier la proc pour comprendre ce qu'elle effectue comme tache.

bye