PDA

View Full Version : [SOLVED:] Copy Used Range Other Workbooks Other Dir n Paste Master WB Sheet1



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

Paul_Hossler
11-06-2023, 10:03 AM
Try this

Also renamed some variables so I could follow



Option Explicit


Sub CommandButton1_Click()
' Change folder path as needed, keep the trailing backslash
Const sFolder = "C:\Users\Daddy\Downloads\" ' back slash !!! <<<<<<<<<<<<<<<

Dim sFile As String
Dim mstWS As Worksheet
Dim srcWB As Workbook
Dim srcWS As Worksheet
Dim t As Long, s As Long, srcNextRow As Long

Application.ScreenUpdating = False

' Target sheet
Set mstWS = ThisWorkbook.Worksheets("Sheet1") ' or use ActiveSheet

' First available target row
t = mstWS.Range("A" & mstWS.Rows.Count).End(xlUp).Row

' Get first Excel filename in the folder
sFile = Dir(sFolder & "*.xls*")

' Loop through the files
Do While sFile <> ""

' Open source workbook
Set srcWB = Workbooks.Open(sFolder & sFile)

If Not srcWB Is ThisWorkbook Then ' don't use this WB <<<<<<<<<<<<<<<<

' Refer to the first sheet
Set srcWS = srcWB.Worksheets(1)

' Get the last used row
srcNextRow = srcWS.Range("A" & srcWS.Rows.Count).End(xlUp).Row + 1

' Copy range
srcWS.Range("A2:Z" & srcNextRow).Copy Destination:=mstWS.Range("A" & t)

' Increment target row
t = t + srcNextRow - 2 ' <<<<<<<<<<<<<<<<< is this what you wanted

' Turn off clipboard
Application.CutCopyMode = False

' Close source workbook
srcWB.Close SaveChanges:=False
End If


' Get next filename
sFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Done"
End Sub

Logit
11-06-2023, 10:49 AM
Thank you for your response. Works brilliantly ! Have a great day !!!