Dummy Excel
Well-known Member
- Joined
- Sep 21, 2005
- Messages
- 1,004
- Office Version
- 2019
- 2010
- 2007
- Platform
- 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:
All help is greatly appreciated
Sam
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
Sam