Я пытаюсь заставить макрос VBA перебирать все файлы xls в определенной папке.Приведенный ниже код работает по большей части.Тем не менее, у меня есть 42 файла в этой папке, и код перебирает только около 26 из них.Все они имеют одинаковое расширение файла.
Я думаю, что либо он не просматривает все файлы.Или он просматривает все файлы, однако существует проблема с последней переменной строки, и данные вставляются поверх.
Sub CopyDataBetweenWorkbooks()
Dim wbSource As Workbook
Dim shTarget As Worksheet
Dim shSource As Worksheet
Dim strFilePath As String
Dim strPath As String
Application.ScreenUpdating = False
' Initialize some variables and
' get the folder path that has the files
Set shTarget = ThisWorkbook.Sheets(1)
strPath = GetPath
' Make sure a folder was picked.
If Not strPath = vbNullString Then
' Get all the files from the folder
strfile = Dir$(strPath & "*.xls", vbNormal)
Do While Not strfile = vbNullString
' Open the file and get the source sheet
Set wbSource = Workbooks.Open(strPath & strfile)
Set shSource = wbSource.Sheets("Trend Report")
'Copy the data
Call CopyData(shSource, shTarget)
'Close the workbook and move to the next file.
wbSource.Close False
strfile = Dir$()
Loop
End If
End Sub
' Procedure to copy the data.
Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)
LastRowSource = shSource.Cells(Rows.Count, "B").End(xlUp).Row
Dim strRANGE_ADDRESS As String
Dim lastrow As String
strRANGE_ADDRESS = "B15:H" & LastRowSource - 1
'insert file name
StrFileFullname = ActiveWorkbook.FullName
shSource.Range("H15:H" & LastRowSource).Value = StrFileFullname
'Copy the data.
shSource.Range(strRANGE_ADDRESS).Copy
'Set last row and paste
lastrow = shTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1
shTarget.Range("B" & lastrow).PasteSpecial xlPasteValuesAndNumberFormats
' Reset the clipboard.
Application.CutCopyMode = xlCopy
End Sub
' Function to get the folder path
Function GetPath() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Select a folder"
.Title = "Folder Picker"
.AllowMultiSelect = False
'Get the folder if the user does not hot cancel
If .Show Then GetPath = .SelectedItems(1) & "\"
End With
End Function