0

I have a folder named "Import" I want to fill up with xls files and import them all at once. The files have the same structure and just require an easy copy and paste to the last cell of my master sheet. With a specific file path it works, but I am not sure how to loop it.

Edit: I tried to implement the Loop. It worked once. After I deleted the data and tried to import them again, I run into 1004 errors, because the Script has a problem with the row "Set UserWorkbook = Application.Workbooks.Open(UserFilename)".

Do I have a logic issue here?

Sub Import_VDL_v2_Button()

'Disable features'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlManual

'Set the target file for import.'
Dim TargetWorkbook As Workbook
Set TargetWorkbook = Application.ActiveWorkbook

'Specifing file directory.'
Dim UserFilename As String
UserFilename = Dir("/Users/Name/Documents/Reporting/Data/Import/" & "*.xls*")

'Start Loop for import.'
Do While Len(UserFilename) > 0
UserFilename = Dir

Dim UserWorkbook As Workbook
Set UserWorkbook = Application.Workbooks.Open(UserFilename)

'Define source and target sheet for copy.'
Dim SourceSheet As Worksheet
Set SourceSheet = UserWorkbook.Worksheets(1)

Dim TargetSheet As Worksheet
Set TargetSheet = TargetWorkbook.Worksheets(1)

'Check for filter and if present, clear all filter in source sheet.'
If SourceSheet.AutoFilterMode = True _
Then SourceSheet.AutoFilter.ShowAllData

'Unhide all rows and columns in source sheet'
SourceSheet.Columns.EntireColumn.Hidden = False
SourceSheet.Rows.EntireRow.Hidden = False

'Copy data from source to last row in target sheet.'
Dim SourceLastRow As Long
SourceLastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

Dim TargetLastRow As Long
TargetLastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Offset(1).Row

SourceSheet.Range("A2:S" & SourceLastRow).Copy
TargetSheet.Range("A" & TargetLastRow).PasteSpecial xlPasteValues

'Close import file and save active file.'
UserWorkbook.Close
ActiveWorkbook.Save

Loop

'Enable features'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub
PerilOS
  • 63
  • 1
  • 11
  • 1
    Are you looking for [this](https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba) perhaps? – BigBen Feb 19 '20 at 14:39
  • 1
    Does this answer your question? [Loop through files in a folder using VBA?](https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba) – Geert Bellekens Feb 19 '20 at 14:41
  • It worked once. But now I have another issue with that (Please see Edit). Thanks so far. – PerilOS Feb 20 '20 at 12:12

0 Answers0