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
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
This question generated 10 answers. To proceed to the answers, click here.
This thread is current as of June 03, 2017.