问题
I am trying to get a VBA macro to loop through all xls files in a specific folder. The below code works for the most part. However i have 42 files in this folder and the code only loops through about 26 of them. They are all the same file extension.
My thoughts are it either isn't looping through all the files. Or it is looping through all the files however there is an issue with the last row variable and data is being pasted over.
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
来源:https://stackoverflow.com/questions/53722989/vba-loop-through-excel-workbooks-in-folder-and-copy-data-not-looping-through-a