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 55 56 57 58 59 60
|
Sub extractiondonnees()
Dim sSource As String
Dim ws As Worksheet
Dim wb As Workbook
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim SelectedFiles() As Variant
Dim NRow As Long
Dim FileName As String
Dim NFile As Long
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim LastRow As Long
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
SelectedFiles = Application.GetOpenFilename(, , "Fichiers Sources", , True)
If SelectedFiles = "False" Then
Exit Sub
End If
NRow = 1
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
FileName = SelectedFiles(NFile)
Set WorkBk = Workbooks.Open(FileName)
SummarySheet.Range("A" & NRow).Value = FileName
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
Set SourceRange = WorkBk.Worksheets(1).Range("A1:S" & LastRow)
Set DestRange = SummarySheet.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
DestRange.Value = SourceRange.Value
NRow = NRow + DestRange.Rows.Count
WorkBk.Close savechanges:=False
Next NFile
SummarySheet.Columns.AutoFit
End Sub |
Partager