Loop code not copying ALL sheets into new workbook

[Lizard07]

I have an "import" macro I've been using that is suppose to copy all the sheets in workbook and move them to another workbook. Instead, it copie the first worksheet multiple times and then moves into the workbook.

Sub ImportDriverTripReport()
Dim ImportItemCount, RowCount As Integer
Dim DCSwb, ImportWb As Workbook
Dim ImportDate As Integer
Dim FileLocation As String
Dim x As Integer

Application.StatusBar = "Please Select the file to Import..."
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
'Import the driver trip report sheet
FileLocation = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
'::: IMPORT THE DATA INTO THE TEMPLATE :::
Set DCSwb = ActiveWorkbook
Application.StatusBar = "Importing File..."
'Opens the file the user specified
Workbooks.Open Filename:=FileLocation
Set ImportWb = ActiveWorkbook
For x = 1 To ActiveWorkbook.Sheets.Count
'Loop through each of the sheets in the workbook by using x as the sheet index number.
ActiveWorkbook.Sheets(x).Copy _
After:=DCSwb.Sheets("Control Panel")
'Puts all copies after the last existing sheet.

Application.StatusBar = Null

Next
End Sub

I can't figure out why its copying the same worksheet multiple times, but I'm assuming it has something to do with the loop coding, which I'm not very good with. Any idea? Thanks!

 

[Joe4]

I believe you may actually need to Activate or Select each sheet before you can copy it, i.e.

Sheets(x).Activate

 

[Lizard07]

I placed the code before the copy piece, but it didn't work....any suggestions?

For x = 1 To ActiveWorkbook.Sheets.Count
'Loop through each of the sheets in the workbook by using x as the sheet index number.
ActiveWorkbook.Sheets(x).Activate
ActiveWorkbook.Sheets(x).Copy _
After:=DCSwb.Sheets("Control Panel")
'Puts all copies after the last existing sheet.

 

[Joe4]

Where did you get your original code from?
Did you take it from a similar project?
Did it ever work work right?
Does the workbook you are copying to already have sheets/data in it (otherwise, you could just re-save the file with a different name if you wanted to make a copy)?
What is the sheet layout of the workbook you are copying to (how many sheets are in it)?

 

[Lizard07]

I took it from a couple of different project, both different. The workbook I'm copying it to has a macro in it that combines the sheets and formats them. I'm using it like a template, so I need to move them into the workbook each time. The number of sheets vary each time, so thats why I'm using a loop code

 

[Joe4]

The workbook I'm copying it to has a macro in it that combines the sheets and formats them. I'm using it like a template, so I need to move them into the workbook each time.

I don't think that is necessary, which should make your process easier. You don't actually need the macros to appear in the Excel workbook you want to run them on. I have a number of Excel Formatting Macros that work on other files. As long as you have both files open simultaneously, you can run macros in one workbook against data in another.

It can even be semi-or fully automated. I have some that bring up a file browser so you can select the file you want to format, and others where my file always has the same name, so it opens that file and runs the macro against it.

 

[Lizard07]

I actually figured it out. I used the F8 function and minimized the VBA screen so I could see what was happening. After copying the first sheet into the new workbook and just continued to copy that same worksheet because teh original workbook was never set back as the active workbook. So I just added the red text below so it would go back to the first workbook each time to copy the sheets over

For x = 1 To ActiveWorkbook.Sheets.Count
'Loop through each of the sheets in the workbook by using x as the sheet index number.
ActiveWorkbook.Sheets(x).Activate
ActiveWorkbook.Sheets(x).Copy _
After:=DCSwb.Sheets("Control Panel")
Workbooks.Open Filename:=FileLocation
Set ImportWb = ActiveWorkbook

 

[Rowland Hamilton]

Folks:

Would this be what I need to make my task work better? I don't want to copy the actual sheets because they have named ranges and I haven't figured out how to bypass/ I just don't want to deal with the message that a named range already exists, do you want to change the name of the duplicate?

Here is how I phrased on another board:

I want to add this functionality to my code:
VBA file browser command to open any workbook to define as SourceWB
What is the easy way to add this functionality to the following code (Or the most efficient way to do what this code does and add this functionality to it)?

Sub Populate_line_item_workbooka()
  
Dim MasterWB As Workbook
Dim SourceWB As Workbook
  
Dim ws As Worksheet
  
Set MasterWB = Workbooks("Line items-Combined.xlsm")
Application.DisplayAlerts = False
'we need to let excel know the Work book then we can define it as SourceWB
Workbooks.Open FileName:=ThisWorkbook.path & "\" & "United States (de linked).xlsm", _
UpdateLinks:=0
Set SourceWB = Workbooks("United States (de linked).xlsm")
'ActiveWorkbook.Names("MyRange").Name  Like "*!*"
 
SourceWB.Activate
Application.DisplayAlerts = False
On Error GoTo ErrorCatch
For Each ws In SourceWB.Worksheets
  'MsgBox (Mid(ws.Name, 5, 10))
'Here I am not sure of like *-Line item* so  I change to be  If Mid(ws.Name, 5, 10) = "-Line item" Then
    'If Mid(ws.Name, 5, 10) = "-Line item" Then 'note: Mid formula won't work bc varying number characters for cc
   If ws.Name Like "*-Line item*" Then
        ws.Select
        Range("A3").Select
   ' the sub is only short one, so no need to splite it into 2 subs, otherwise we need to activate the  Windows("Line items-Combined.xlsm") again before redefine it as SourceWB, then we can use SourceWB
    'copy
        Range("A3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
  
        
    'paste
        MasterWB.Activate
        Sheets("Master-Incoming").Activate
        Range("A65000").Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
        SourceWB.Activate
        'Exit for...No need to be Exit for here, for each......then will loop until last object in for is performed then it will stop itself.
    End If
    
Next ws
  
  MasterWB.Activate
ErrorCatch:
    
  SourceWB.Activate
  Application.CutCopyMode = False
  Range("A1").Select
  
  MasterWB.Activate
  Range("A1").Select
  
  MsgBox ("No More Sheets To Copy") 'Err.Description
End Sub

Thank you - Rowland