About Us

Royzer

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

Gord Dibben[_2_]

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

For i = 1 To SheetCnt - 4

Gord

GS[_2_]

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

GS[_2_]

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

GS[_2_]

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

Royzer

Quote:

Originally Posted by Gord Dibben[_2_]

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

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
delete row off 5 worksheets containing specific value	PVANS	Excel Programming	8	April 6th 10 04:59 PM
Copy-Pasting row into exact same row on specific other worksheets	PVANS	Excel Programming	1	April 1st 10 11:36 AM
Select specific worksheets & copy - code problem	BeSmart	Excel Programming	2	March 11th 10 11:30 AM
Copy data to multiple specific worksheets?	Hogometer	Excel Programming	4	November 9th 06 12:13 AM
print specific worksheets in specific order.	jarvo	Excel Programming	1	April 11th 06 11:05 AM

Menu

About Us