leemcder
09-16-2020, 02:47 AM
Hi everyone, hoping someone can help me with a problem I've got.
The code below extracts data from multiple excel spreadsheets in a folder, works great for that. We than add extra data etc ourselves.
What I'd like is also an option to update the data, so any new excel documents added to the folder since the macro was run last run it will just add those to the bottom of the existing data. (I don't want to clear the data and populate the whole data again as we would lose any extra data we have added ourselves) Is anyone able to help with that please?
Many thanks
Sub ExtracData()
Dim summary As Workbook
Dim wb As Workbook
Dim directory As String
Dim fileName As String
Dim NextRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set summary = ThisWorkbook
directory = summary.Worksheets("Sheet1").Range("A1")
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(directory & fileName)
wb.Worksheets("data").Range("A1:G1").Copy
summary.Activate
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
Worksheets("Sheet1").Range("A" & NextRow).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wb.Close savechanges:=False
End If
fileName = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Updated"
End Sub
The code below extracts data from multiple excel spreadsheets in a folder, works great for that. We than add extra data etc ourselves.
What I'd like is also an option to update the data, so any new excel documents added to the folder since the macro was run last run it will just add those to the bottom of the existing data. (I don't want to clear the data and populate the whole data again as we would lose any extra data we have added ourselves) Is anyone able to help with that please?
Many thanks
Sub ExtracData()
Dim summary As Workbook
Dim wb As Workbook
Dim directory As String
Dim fileName As String
Dim NextRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set summary = ThisWorkbook
directory = summary.Worksheets("Sheet1").Range("A1")
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(directory & fileName)
wb.Worksheets("data").Range("A1:G1").Copy
summary.Activate
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
Worksheets("Sheet1").Range("A" & NextRow).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wb.Close savechanges:=False
End If
fileName = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Updated"
End Sub