Logit
11-06-2023, 09:32 AM
The following macro is straight from the MS website ... doesn't work ... surprise ! My frustration level after several days is indescribable. Please help.
There are three workbooks sitting in a folder named TEST that is sitting on my desktop. The master workbook named Master is sitting on the desktop adjacent to this folder.
The three workbooks are named Book1, Book2, Book3.
The macro should open each workbook, one at a time, copy the used range on sheet named Staffing-Processes and paste that in the Master workbook / Sheet1 first blank row column A.
The macro runs flawlessly here - no errors ... but it doesn't do anything !
Sub CommandButton1_Click() ' Change folder path as needed, keep the trailing backslash
Const sFolder = "C:\Users\gagli\OneDrive\Desktop\Test"
Dim sFile As String
Dim wshT As Worksheet
Dim t As Long
Dim wbkS As Workbook
Dim wshS As Worksheet
Dim s As Long
Dim m As Long
Application.ScreenUpdating = False
' Target sheet
Set wshT = ThisWorkbook.Worksheets("Sheet1") ' or use ActiveSheet
' First available target row
t = wshT.Range("A" & wshT.Rows.Count).End(xlUp).Row + 2
' Get first Excel filename in the folder
sFile = Dir(sFolder & "*.xls*")
' Loop through the files
Do While sFile <> ""
' Open source workbook
Set wbkS = Workbooks.Open(sFolder & sFile)
' Refer to the first sheet
Set wshS = wbkS.Worksheets(1)
' Get the last used row
m = wshS.Range("A" & wshS.Rows.Count).End(xlUp).Row
' Copy range
wshS.Range("A2:Z" & m).Copy Destination:=wshT.Range("A" & t)
' Increment target row
t = t + m - 1
' Turn off clipboard
Application.CutCopyMode = False
' Close source workbook
wbkS.Close SaveChanges:=False
' Get next filename
sFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
There are three workbooks sitting in a folder named TEST that is sitting on my desktop. The master workbook named Master is sitting on the desktop adjacent to this folder.
The three workbooks are named Book1, Book2, Book3.
The macro should open each workbook, one at a time, copy the used range on sheet named Staffing-Processes and paste that in the Master workbook / Sheet1 first blank row column A.
The macro runs flawlessly here - no errors ... but it doesn't do anything !
Sub CommandButton1_Click() ' Change folder path as needed, keep the trailing backslash
Const sFolder = "C:\Users\gagli\OneDrive\Desktop\Test"
Dim sFile As String
Dim wshT As Worksheet
Dim t As Long
Dim wbkS As Workbook
Dim wshS As Worksheet
Dim s As Long
Dim m As Long
Application.ScreenUpdating = False
' Target sheet
Set wshT = ThisWorkbook.Worksheets("Sheet1") ' or use ActiveSheet
' First available target row
t = wshT.Range("A" & wshT.Rows.Count).End(xlUp).Row + 2
' Get first Excel filename in the folder
sFile = Dir(sFolder & "*.xls*")
' Loop through the files
Do While sFile <> ""
' Open source workbook
Set wbkS = Workbooks.Open(sFolder & sFile)
' Refer to the first sheet
Set wshS = wbkS.Worksheets(1)
' Get the last used row
m = wshS.Range("A" & wshS.Rows.Count).End(xlUp).Row
' Copy range
wshS.Range("A2:Z" & m).Copy Destination:=wshT.Range("A" & t)
' Increment target row
t = t + m - 1
' Turn off clipboard
Application.CutCopyMode = False
' Close source workbook
wbkS.Close SaveChanges:=False
' Get next filename
sFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Done"
End Sub