У меня есть папка с именем «Импорт», которую я хочу заполнить файлами xls и импортировать их все сразу. Файлы имеют одинаковую структуру и требуют простого копирования и вставки в последнюю ячейку моего мастер-листа. С указанным c путем к файлу он работает, но я не уверен, как его oop.
Редактировать: Я пытался реализовать L oop. Это сработало один раз. После того, как я удалил данные и попытался импортировать их снова, я столкнулся с ошибкой 1004, поскольку в скрипте возникла проблема со строкой «Установить UserWorkbook = Application.Workbooks.Open (UserFilename)».
Есть ли у меня логи c проблема здесь?
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