How do I combine one sheet from multiple workbooks into one summary workbook using VBA?

post copies of the excel files.

you can do this by importing the excel sheets to a table in Access then
export the table to a new excel file..

The attached VBA will loop through each Excel file in a specified folder and copy a sheet with a specified name to the workbook in which the code is running.
Change "MyFolder" and "MySheetName" as required.

Sub Run()
    CopyWorkSheets "C:\MyFolder\", "MySheetName"
End Sub
 
Sub CopyWorkSheets(strDirectory As String, strSheetName As String)
 
    Dim xlThisWB As Workbook
    Dim xlWB As Workbook
    Dim xlWS As Worksheet
    Dim strFileName As String
    Dim iCount As Integer
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
 
    On Error Resume Next
 
    Set xlThisWB = ThisWorkbook
    strFileName = Dir(strDirectory & "*.xls")
 
    Do While strFileName <> ""
        With xlThisWB
            Set xlWB = Workbooks.Open(Filename:=strDirectory & strFileName)
            Set xlWS = xlWB.Worksheets(strSheetName)
            xlWS.Copy after:=xlThisWB.Worksheets(xlThisWB.Worksheets.Count)
            xlWB.Close
        End With
        strFileName = Dir()
    Loop
 
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
 
End Sub

Select allOpen in new window

Thank you for your quick reply. I tried the code and I may be missing something as I am fairly new to code. I entered in the directory location and the worksheet name and when I run the macros nothing is occuring. I have also attached the changes I made in the code for your reference. If you could respond once again that would be wonderful...thanks

Sub Run()
    CopyWorkSheets "C:\TimeSheets\2009\(1) 15 January 09", "jan"
End Sub
 
Sub CopyWorkSheets(strDirectory As String, strSheetName As String)
 
    Dim xlThisWB As Workbook
    Dim xlWB As Workbook
    Dim xlWS As Worksheet
    Dim strFileName As String
    Dim iCount As Integer
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
 
    On Error Resume Next
 
    Set xlThisWB = ThisWorkbook
    strFileName = Dir(strDirectory & "*.xls")
 
    Do While strFileName <> ""
        With xlThisWB
            Set xlWB = Workbooks.Open(Filename:=strDirectory & strFileName)
            Set xlWS = xlWB.Worksheets(strSheetName)
            xlWS.Copy after:=xlThisWB.Worksheets(xlThisWB.Worksheets.Count)
            xlWB.Close
        End With
        strFileName = Dir()
    Loop
 
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
 
End Sub

Select allOpen in new window

Are you using Excel 2007?  If you are then your excel files might be saved in .xlsx format.  If this is the case you should change this line..
strFileName = Dir(strDirectory & "*.xls")
to..
strFileName = Dir(strDirectory & "*.xlsx")

otherwise, try stepping through the code (put the cursor just after "Sub Run()" and press F8 repeatedly) and see if it runs as expected.

Hi,
The version I am currently utilizing is 2003. I attempted the F8 and it runs through the macro, but there is no action occuring. It could just be some simple step I am over looking. I have attached a copy of the file for your reference. I am trying to get the two files employee tracker workbook (AB& NWT) and (BC)to copy "jan" into the worbook called "final". I have posted the macros in the workbook final. For some reason the macros has no effect on the workbook. In future use this macro could take up to 50 peoples pay and only past the jan sheet into one workbook, but I have created a small file for your reference.

Thank you for all your assistance it worked wonderfully.....

Glad to help.