Hi,
I have a macro (below) that should loop through a catalog and for
every file copy and paste each sheet. But it only takes one of four
sheets and copies that four times. I have tried all options but are
stuck. All help are appreciated.
Why doesnt it change sheet?

Thanks in advance


Sub create_database()
'
' create_database Macro
' Macro recorded 24/04/2007 by
'

'
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = True
Application.DisplayAlerts = False
Application.EnableEvents = True

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "\\Expense planning"
.FileType = msoFileTypeExcelWorkbooks
.Filename = "*.xls"

Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"\\Expense planning\database\database_budget.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Workbooks.Open Filename:= _
"\\Expense planning\3. 44001 Group Marine 2007.xls", _
UpdateLinks:=0

' First sheet to copy header from
Windows("3. 44001 Group Marine 2007_database.xls").Activate
Sheets("US").Select
' Select the area to copy header
Range("A5:T5").Select
Selection.Copy
' Switch to database to paste
Windows("database_budget.xls").Activate
' Paste header
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("3. 44001 Group Marine 2007_database.xls").Close
SaveChanges:=False

' ////////////////////////////////////////////////////////////////////////////////////////////////////////
If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults =
Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)



' ///////////////////////////////////////////////////////////////////////////////////////////////////////
' Activate first sheet to copy budget from
' Windows(wbResults).Activate
' ActiveWorkbook.Select
' ActiveWorksheet.Select
' Sheet.Select
' Sheets("US").Select
Worksheets("US").Select

Range("A6:T140").Select
Selection.Copy
' Switch to database to paste
Windows("database_budget.xls").Activate
' Move to the last cell
Cells(Rows.Count, ActiveCell.Column).End(xlUp).Offset(1,
0).Select
' Paste content
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' End copy first sheets tab
' Activate first sheet to copy budget from

' Windows(wbResults).Activate
' Sheets.Select
' Sheets("Bda").Select
Worksheets("Bda").Select
Range("A6:T140").Select
Selection.Copy
' Switch to database to paste
Windows("database_budget.xls").Activate
' Move to the last cell
Cells(Rows.Count, ActiveCell.Column).End(xlUp).Offset(1,
0).Select
' Paste content
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' End copy first sheet
' Activate first sheet to copy budget from

' Windows(wbResults).Activate
Sheets("5").Select
Range("A6:T140").Select
Selection.Copy
' Switch to database to paste
Windows("database_budget.xls").Activate
' Move to the last cell
Cells(Rows.Count, ActiveCell.Column).End(xlUp).Offset(1,
0).Select
' Paste content
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' End copy first sheet
' Activate first sheet to copy budget from

' Windows(wbResults).Activate
Sheets("6").Select
Range("A6:T140").Select
Selection.Copy
' Switch to database to paste
Windows("database_budget.xls").Activate
' Move to the last cell
Cells(Rows.Count, ActiveCell.Column).End(xlUp).Offset(1,
0).Select
' Paste content
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' End copy first sheet
wbResults.Close SaveChanges:=True

Next lCount
End If
End With

On Error GoTo 0
' Save the Database
Windows("database_budget.xls").Activate
ActiveWorkbook.Save

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub