Hi. I have a wb with 20 sheets. I need to copy the data ranges from the first 17, but not the last 3, "Create File", "Pull" and "Save as DIF". The data will be pasted on a new sheet named "Target" created by the code. The code below does everything I want it to EXCEPT it also copies and pastes the three sheets above. How can I modify the code to exclude these three sheets?
Thank you.
Code:
Sub CombineSheets()
'This macro will copy data from worksheets and past to "Target" sheet
Dim i As Integer
Dim j As Long
Dim SheetCnt As Integer
Dim lstRow1 As Long
Dim lstRow2 As Long
Dim lstCol As Integer
Dim ws1 As Worksheet
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
On Error Resume Next
'Delete the Target Sheet on the document (in case it exists)
Sheets("Target").Delete
'Count the number of sheets on the Workbook
SheetCnt = Worksheets.Count
'Add the Target Sheet
Sheets.Add after:=Worksheets(SheetCnt)
ActiveSheet.Name = "Target"
Set ws1 = Sheets("Target")
lstRow2 = 1
'Define the row where to start copying
j = 7
'Combine the sheets
For Each ws1 In Worksheets
If ws1.Name < "Pull" Then
For i = 1 To SheetCnt
Worksheets(i).Select
'check what is the last column with data
lstCol = ActiveSheet.Cells(5, ActiveSheet.Columns.Count).End(xlToLeft).Column
'check what is the last row with data
lstRow1 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
'Define the range to copy
Range("A" & 7, Cells(lstRow1, lstCol)).Select
'Copy the data
Selection.Copy
ws1.Range("A" & lstRow2).PasteSpecial
Application.CutCopyMode = False
'Define the new last row on the Target sheet
lstRow2 = ws1.Cells(65536, "A").End(xlUp).Row + 1
'Define the row where to start copying
j = 2
Next
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Sheets("Target").Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
VBA-copy all worksheets except three specific ones
Similar Threads
Threaded Mode
