Hello,
I am trying to copy worksheets into one worksheet named combined but I need to keep sheet(1). Then I want to delete the sheets I copied. So far I have failed, the code I have is below but I think the file I have shared has the wrong code. the below code is what I am trying to get to work for Combined worksheet.
Sub CombineWorksheets()
Dim wsSrc As Worksheet
Dim wsDest As Worksheet
Dim rngDest As Range
Dim lastRow As Long
Dim destRow As Long
Set wsDest = Worksheets("Combined")
Set rngDest = wsDest.Range("A1")
Application.DisplayAlerts = False
'loop through all source sheets in this workbook
For Each wsSrc In ThisWorkbook.Sheets
If wsSrc.Name <> "Summary" Then 'all sheets except Summary
lastRow = wsSrc.Cells.SpecialCells(xlCellTypeLastCell).Row
wsSrc.Range("A1", wsSrc.Range("O" & lastRow)).Copy Destination:=rngDest
Set rngDest = rngDest.Offset(lastRow - 1) 'update the destination range
wsSrc.Delete 'delete the source worksheet without a prompt
End If
Next
Application.DisplayAlerts = True 'Turn prompts back on
End Sub
I am trying to copy worksheets into one worksheet named combined but I need to keep sheet(1). Then I want to delete the sheets I copied. So far I have failed, the code I have is below but I think the file I have shared has the wrong code. the below code is what I am trying to get to work for Combined worksheet.
Sub CombineWorksheets()
Dim wsSrc As Worksheet
Dim wsDest As Worksheet
Dim rngDest As Range
Dim lastRow As Long
Dim destRow As Long
Set wsDest = Worksheets("Combined")
Set rngDest = wsDest.Range("A1")
Application.DisplayAlerts = False
'loop through all source sheets in this workbook
For Each wsSrc In ThisWorkbook.Sheets
If wsSrc.Name <> "Summary" Then 'all sheets except Summary
lastRow = wsSrc.Cells.SpecialCells(xlCellTypeLastCell).Row
wsSrc.Range("A1", wsSrc.Range("O" & lastRow)).Copy Destination:=rngDest
Set rngDest = rngDest.Offset(lastRow - 1) 'update the destination range
wsSrc.Delete 'delete the source worksheet without a prompt
End If
Next
Application.DisplayAlerts = True 'Turn prompts back on
End Sub