Hello,
I would like to copy the entire contents (data) of "Sheet1" from multiple workbooks all under a folder to a master workbook named Headcount Rollup Template. Each sheet should be imported to a particular tab in the master.

I have set up a sheet within my master called "Tab Names" that contains the table I am referencing to map the file to the sheet tab name. It is set up like this:

Wbk Name Sht Name
Active HC - US Data.xls US HC
Active HC - UK Data.xls UK HC
Active HC - France Data.xls FRA HC

Example: all data in "Sheet1" in Active HC - US Data.xls should be copied to tab "US HC" in master workbook

I have been working with the code below but getting an "Object Required" error when it runs.

Here is my current code that returns an object required error:

Sub ImportSheets()
Dim Path As String
Dim filename As String
Dim sht As Worksheet
Dim wkB As Workbook
Dim i As Integer
Dim r As Range
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Import the first worksheet for each file under R:\HC Data
Path = "R:\HR Ops Team Folders\Reporting & Analysis\Headcount\HC Data"
filename = Dir(Path & "\*.xls")
i = 1
Do While filename <> ""
For Each r In Worksheets("Tab Names").Range("A2:A9")
If r.Value = filename Then
'this assumes that the sheet name is in the next column
Set sht = ThisWorkbook.Sheets(r.Offset(0, 1).Value)
Exit For
End If
Next
Workbooks.Open filename:=Path & "\" & filename
If SheetExists("Sheet1") Then
Set wkB = ActiveWorkbook
Wbk.Sheets("Sheet1").Cells.Copy Destination:=sht.[A1]
'ActiveSheet.Name = "Sheet" & i
i = i + 1
wkB.Close savechanges:=False
Else
MsgBox "Sheets1 does not exist in file '" & filename & "'", vbExclamation, "ERROR !!"
ActiveWorkbook.Close savechanges:=False
End If
filename = Dir
Loop
Sheets("Tracking #").Select
MsgBox "All files have been imported successfully!"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

__________________________________________________ _________
Function SheetExists(ByVal sName As String)
Dim sht As Worksheet

SheetExists = True
For Each sht In ActiveWorkbook.Sheets
If sht.Name = sName Then Exit Function
Next sht

SheetExists = False
End Function


Any help is greatly appreciated!!

Sorry, should have been more clear about the error.

The code will run until it gets to this line:
Wbk.Sheets("Sheet1").Cells.Copy Destination:=sht.[A1]

When I hit the debug button, the error message appears:
"Run-Time Error "424": Object Required

Then in the watch window it displays:
Expression Value Type
Importsheets <Expression not defined in context> Empty

Hi

Just a shot in the dark but you could try this small mod to your code
This eliminates trying to copy data from a file that is not in your list, and hence will not have the Sht object set (or is set to an object that no longer exists) !?

MTB

Thanks Mike!

I set the r value and this code seems to work. I am sure it can probably be cleaned up a bit though.

Sub ImportSheets()
Dim Path As String
Dim filename As String
Dim sht As Worksheet
Dim wkB As Workbook
Dim i As Integer
Dim r As Range
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Set the file path
Path = Worksheets("wsTabNames").Range("Path")
filename = Dir(Path & "\*.xls")
i = 1
Do While filename <> ""
'set filenames in worksheet "wsTabNames" in A column to tab name in B column
Set sh1 = Sheets("wsTabNames")
Set r = sh1.Range(sh1.Range("A2"), sh1.Range("A2").End(xlDown)) 'this selects all files names in Column A in sheet "wsTabnames"
For Each r In sh1.Range(sh1.Range("A2"), sh1.Range("A2").End(xlDown))
If r.Value = filename Then
Set sht = ThisWorkbook.Sheets(r.Offset(0, 1).Value) 'this assigns filename to tab name in sheet "wsTabNames"
Exit For
End If
Next
'Next import the first worksheet for each file under R:\HC Data
Set wbK = Workbooks.Open(filename:=Path & "\" & filename)
If SheetExists("Sheet1") Then
Set wkB = ActiveWorkbook
wbK.Sheets("Sheet1").Cells.Copy 'this copies data to assigned r value tab name
sht.[A1].PasteSpecial xlPasteValues
ActiveSheet.Name = "Sheet" & i
i = i + 1
wkB.Close savechanges:=False
Else
MsgBox "Sheets1 does not exist in file '" & filename & "'", vbExclamation, "ERROR !!"
ActiveWorkbook.Close savechanges:=False
End If
filename = Dir
Loop

Sheets("Forecast Data").Select
MsgBox "All files have been imported successfully!"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub