Copying Columns

[mansoor2840]

Dear All,
i have 10 worksheet in a workbook which i update regularly i want a have new sheet where colA and colE are copied from 8 worksheet out of 10.
Thanks in advance for your help.

 

[mumps]

What are the names of the 2 sheets that you don't want to copy? What is the name of the new sheet? Do you want the columns from each sheet copied underneath each other in column A and column B of the new sheet?

 

[mansoor2840]

Sheet1 to sheet8 to be copied to sheet 11 yes the data should be below each other that is sheet1 colA followed by sheet1 colA. And sheet 1 ColE to followed by sheet2 ColE Sheet9 and sheet 10 not be copied.

 

[mumps]

Try:

Sub copyCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long, x As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = 1 To 8
        With Sheets(x)
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("A1:A" & LastRow).Copy Sheets(11).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Range("E1:E" & LastRow).Copy Sheets(11).Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
        End With
    Next x
    Application.ScreenUpdating = True
End Sub

 

[mansoor2840]

Thanks for code
i have sheet names as product names so how to use the code
for example: sheet 1 - hamm, sheet 2 - schwing

 

[mumps]

What are the names of the 8 sheets you want to copy?

 

[mansoor2840]

Sheet1-hamm, sheet2-viegele, sheet3-paver
Sheet11-master

 

[mumps]

That's 3 sheets. I thought you said you wanted to copy from 8 sheets. Please clarify.

 

[mansoor2840]

You can help me by 3 sheets

 

[mumps]

Try:

Sub copyCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet
    For Each ws In Sheets(Array("hamm", "viegele", "paver")) '[COLOR="#FF0000"]add additional sheets if necessary[/COLOR]
        With ws
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("A1:A" & LastRow).Copy Sheets(11).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Range("E1:E" & LastRow).Copy Sheets(11).Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub