1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
| Sub Test()
Dim Cl As Workbook
Dim Fe As Worksheet
Dim PlgChemin As Range
Dim PlgValeur As Range
Dim Cel As Range
Dim Lig As Long
'défini la plage sur la colonne B à partir de B4 contenant les chemins des dossiers avec noms des classeurs, adapter le nom de la feuille, ne le connaissant pas, j'ai mis "Feuil1" !
With ThisWorkbook.Worksheets("Actions en cours"): Set PlgChemin = .Range(.Cells(4, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
'feuille du classeur où se trouve la macro devant recevoir les valeurs
Set Fe = ThisWorkbook.Worksheets("Actions en cours")
'gèle
Application.ScreenUpdating = False
'parcours la plage des chemins
For Each Cel In PlgChemin
'contrôle si valide
If Dir(Cel.Value) <> "" Then
'ouvre le classeur
Set Cl = Workbooks.Open(Cel.Value)
'défini la plage de A1 à Ex
With Cl.Worksheets("Actions en cours"): Set PlgValeur = .Range(.Cells(1, 1), .Cells(.Rows.Count, 5).End(xlUp)): End With
'si pas vide...
If Not PlgValeur Is Nothing Then
'...inscrit les valeurs les unes à la suite des autres...
With Fe
Lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
.Range(.Cells(Lig, 1), .Cells(PlgValeur.Rows.Count + Lig - 1, 5)).Value = PlgValeur.Value
End With
End If
'...puis referme le classeur
Cl.Close False
End If
Next Cel
'rafraîchi
Application.ScreenUpdating = True
End Sub |
Partager