ExcelBanter - VBA-copy all worksheets except three specific ones

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - VBA-copy all worksheets except three specific ones (https://www.excelbanter.com/excel-programming/446018-vba-copy-all-worksheets-except-three-specific-ones.html)

VBA-copy all worksheets except three specific ones

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

If the three sheets plus Target sheet are at the end as you state, try
this............

For i = 1 To SheetCnt - 4

Gord

VBA-copy all worksheets except three specific ones

I suggest a different approach...

a. Put the sheetnames that are NOT to be copied in a delimited string
and store that in a constant in your procedu

Const sSheetsNotToCopy$ = "Create File,Pull,Save as DIF,Target"

b. Use a variable to ref the new target sheet:

Dim wksTarget As Worksheet
Set wksTarget = Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
wksTarget.Name = "Target"

c. Iterate the worksheets and process them:

Dim wks As Worksheet, rngDataToCopy As Range, rngTarget As Range
Dim lLastRow&, lLastCol&
Const lStartRow& = 7 '1st row containing data on source sheets

For Each wks in ActiveWorkbook.Worksheets
If Not InStr(sSheetsNotToCopy, wks.Name) 0 Then
'Here's where you copy the data to wksTarget
'I suggest you use a consistent method to find the last row of
'each sheet to be copied, so as not to hard-code the # of rows.

'Get the range of data
lLastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
lLastCol = wks.Cells(5, wks.Columns.Count(.End(xlToLeft).Column
'The above assumes data starts same row on every source sheet.

'Copy the data to wksTarget on the next blank row
'(Assumes first row only is blank, or has/will have headings)
Set rngTarget = _
wksTarget.Range("A" & wksTarget.UsedRange.Rows.Count + 1)
wks.Range("A" & lStartRow, wks.Cells(lLastRow, lLastCol).Copy _
Destination:=rngTarget
End If
Next 'wks

d. After data is copied you can set your column widths.

With wksTarget: .Columns.AutoFit: .Cells(1, 1).Select: End With

Note that wksTarget became the active sheet when it was added, and
remaines the active sheet throughout the process. This means the only
UI setting you need to toggle is ScreenUpdating since there's no
selecting going on during the procedure.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

VBA-copy all worksheets except three specific ones

I was originally intending to write the loop as follows for better
clarit...

Dim wks As Worksheet, rngDataToCopy As Range, rngTarget As Range
Dim lLastRow&, lLastCol&
Const lStartRow& = 7 '1st row containing data on source sheets

For Each wks in ActiveWorkbook.Worksheets
If Not InStr(sSheetsNotToCopy, wks.Name) 0 Then
'Here's where you copy the data to wksTarget
'I suggest you use a consistent method to find the last row of
'each sheet to be copied, so as not to hard-code the # of rows.

'Get the range of data
lLastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
lLastCol = wks.Cells(5, wks.Columns.Count(.End(xlToLeft).Column
'The above assumes data starts same row on every source sheet.

'Copy the data to wksTarget on the next blank row
'(Assumes first row only is blank, or has/will have headings)
Set rngTarget = _
wksTarget.Range("A" & wksTarget.UsedRange.Rows.Count + 1)
Set rngDataToCopy = _
wks.Range("A" & lStartRow, wks.Cells(lLastRow, lLastCol)
rngDataToCopy.Copy Destination:=rngTarget
End If
Next 'wks

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

VBA-copy all worksheets except three specific ones

After serious thinking I realize I'm missing a closing parenthesis

Dim wks As Worksheet, rngDataToCopy As Range, rngTarget As Range
Dim lLastRow&, lLastCol&
Const lStartRow& = 7 '1st row containing data on source sheets

For Each wks in ActiveWorkbook.Worksheets
If Not InStr(sSheetsNotToCopy, wks.Name) 0 Then
'Here's where you copy the data to wksTarget
'I suggest you use a consistent method to find the last row of
'each sheet to be copied, so as not to hard-code the # of rows.

'Get the range of data
lLastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
lLastCol = wks.Cells(5, wks.Columns.Count(.End(xlToLeft).Column
'The above assumes data starts same row on every source sheet.

'Copy the data to wksTarget on the next blank row
'(Assumes first row only is blank, or has/will have headings)
Set rngTarget = _
wksTarget.Range("A" & wksTarget.UsedRange.Rows.Count + 1)
Set rngDataToCopy = _
wks.Range("A" & lStartRow, wks.Cells(lLastRow, lLastCol))
rngDataToCopy.Copy Destination:=rngTarget
End If
Next 'wks

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Quote:

Originally Posted by Gord Dibben[_2_] (Post 1601685)

If the three sheets plus Target sheet are at the end as you state, try
this............

For i = 1 To SheetCnt - 4

Gord

Gord, your code worked perfectly. I had miscounted the number of sheets, but when I changed the -4 to -3 it did exactly what I wanted it to do.

I added:

Code:

For i = 1 To(SheetCnt -3)

and removed:

Code:

If ws1.Name < "Pull" Then