I have attempted to write code to copy data from sheets(3) (this is a Pivot Table) in Columns A:F called from all workbooks containing "South End Debtors.xlsm, Conti Debtors.xlsm etc" in folder C:\Debtors
When runig the macro, I do not get any eeror messages, but no data is being copied into sheet1 in the destination workbook containing the macro
It would be appreciated if someone could kindly assist me
When runig the macro, I do not get any eeror messages, but no data is being copied into sheet1 in the destination workbook containing the macro
It would be appreciated if someone could kindly assist me
Code:
Sub Open_Spec_Files()
Dim objFSO As Object
Dim objMyFolder As Object
Dim objMyFile As Object
Dim wbMyWorkBook As Workbook
Dim lngLastRow As Long
Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objMyFolder = objFSO.GetFolder("C:\Debtors")
For Each objMyFile In objMyFolder.Files
If objFSO.GetExtensionName(objMyFile) = "xlsm" And StrConv(Left(objFSO.GetBaseName(objMyFile), 7), vbUpperCase) = "Debtors" Then
'...set the wbMyWorkBook variable by opening the workbook and copy the data from range A4:O[lngLastRow].
Set wbMyWorkBook = Workbooks.Open(objMyFolder & "\" & objMyFile.Name)
On Error Resume Next
lngLastRow = wbMyWorkBook.Sheets(3).Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
On Error GoTo 0
If lngLastRow >= 4 Then
With wbMyWorkBook
.Sheets(1).Range("A4:F" & lngLastRow).Copy Destination:=ThisWorkbook.ActiveSheet.Range("A2")
.Close SaveChanges:=False
End With
End If
End If
Next objMyFile
Set objFSO = Nothing
Set objMyFolder = Nothing
Application.ScreenUpdating = True
End Sub
Last edited: