worksheets

Dummy Excel

Well-known Member
Joined
Sep 21, 2005
Messages
1,003
Office Version
  1. 2019
  2. 2010
  3. 2007
Platform
  1. Windows
Hi All,
This is a little tricky to explain so bear with me here!

I have a spreadsheet which could have 1 or more sheets. All the sheets are in the exact same format as the sheets are templates.

Currently my macro goes to the first sheet copies the sheet to the summary page and then goes back and copies the data to my summary page although I cant get the macro to go to the second sheet. Any ideas?
My code is:
Code:
ChDir strPath
strExtension = Dir(strPath & "*.xlsx")

        Do While strExtension <> ""
            Set wbOpen = Workbooks.Open(strPath & strExtension)
         
            With wbOpen
                ActiveWorkbook.Sheets(1).Select
                StatusReport = ActiveWorkbook.Name
                ProjectSheet = ActiveSheet.Name
            
            'Copy worksheets
            wsc = Worksheets.Count
            For Each ws In Worksheets
                    ws.Copy after:=Workbooks("Flightplan.xlsx").Sheets(3)

                'Copy Project Name
                Windows(StatusReport).Activate
                If wsc = 1 Then
                    Range("C5").Select.UnMerge
                    Range("C5").Copy
                    Windows(Flightplan).Activate
                    Sheets("Lookup Table").Activate
                Else
                    ActiveSheet.Next.Select
                    Range("C5").Select.UnMerge
                    Range("C5").Copy
                    Windows(Flightplan).Activate
                    Sheets("Lookup Table").Activate
                End If
                For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
                If Range("A" & i + 1).Value = "" Then
                Range("A" & i + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Else
                If i = i Then
                Else
                Range("A1").End(xlDown).Offset(1, 0).Select
                Range("A" & i + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                End If
                End If
                Next i
            
    
                Windows(StatusReport).Activate
    
                'Copy Owner
                Range("E6").Copy
                Windows(Flightplan).Activate
    
                For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
                If Range("B" & i + 1).Value = "" Then
                Range("B" & i + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Else
                If i = i Then
                Else
                Range("B1").End(xlDown).Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False
                End If
                End If
                Next i

                Windows(StatusReport).Activate
    
                'Copy Comments
                Range("G5").UnMerge
                Range("G5").Copy
                Windows(Flightplan).Activate
                
                For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
                If Range("C" & i + 1).Value = "" Then
                Range("C" & i + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Else
                If i = i Then
                Else
                Range("C1").End(xlDown).Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                End If
                End If
                Next i

                Windows(StatusReport).Activate
    
                'Copy Update
                Range("L8").UnMerge
                Range("L8").Copy
                Windows(Flightplan).Activate
    
                For i = 1 To Range("D" & Rows.Count).End(xlUp).Row
                If Range("D" & i + 1).Value = "" Then
                Range("D" & i + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Else
                If i = i Then
                Else
                Range("D1").End(xlDown).Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                End If
                End If
                Next i

                Windows(StatusReport).Activate
    
                'Copy Overall Status
                Range("L5").Copy
                Windows(Flightplan).Activate
    
                For i = 1 To Range("E" & Rows.Count).End(xlUp).Row
                If Range("E" & i + 1).Value = "" Then
                Range("E" & i + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Else
                If i = i Then
                Else
                Range("E1").End(xlDown).Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                End If
                End If
                Next i

                Windows(StatusReport).Activate
            
            Next ws
        End With
                
                Application.DisplayAlerts = False
                ActiveWorkbook.Close
                Application.DisplayAlerts = True
          
            strExtension = Dir
        Loop
All help is greatly appreciated
Sam
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,450
I think one problem might be the use of With wbOpen. Here's a partial example on how you should use it...

Code:
            With wbOpen
                '.Sheets(1).Select
                StatusReport = [COLOR="Red"].[/COLOR]Name
                ProjectSheet = [COLOR="Red"].Sheets(1)[/COLOR].Name
            
            'Copy worksheets
            wsc = [COLOR="Red"].[/COLOR]Worksheets.Count
            For Each ws In [COLOR="Red"].[/COLOR]Worksheets
                    ws.Copy after:=Workbooks("Flightplan.xlsx").Sheets(3)
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,613
Messages
5,832,710
Members
430,155
Latest member
spacedad41

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top