VBA Copy from multiple sheets

[thedeadzeds]

Hi Guys,

I have 5 worksheets named as per below:
Brecon
Chepstow
Chippenham
Bath two
Merthry one

In each worksheet there is a column called 'Name'. I essentially want to filter by each name in that column and copy them all to one worksheet. For example, filter by Bethan in all of the 5 worksheets and copy all the data from column A to N to the worksheet called 'Bethan'.

Hope this makes sense. Thanks in advance

 

[mumps]

In which column are the names? Do the 'name' sheets already exist or do they have to be created?

 

[thedeadzeds]

In which column are the names? Do the 'name' sheets already exist or do they have to be created?

Hi, thanks for coming back to me. The names are in column J and the sheets are already created.

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, name As Range, item As Variant, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each ws In Sheets(Array("Brecon", "Chepstow", "Chippenham", "Bath two", "Merthry one"))
        LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each name In ws.Range("J2:J" & LastRow)
            If Not RngList.exists(name.Value) Then
                RngList.Add name.Value, Nothing
            End If
        Next name
        For Each item In RngList
            ws.Range("J1:J" & LastRow).AutoFilter Field:=1, Criteria1:=item
            ws.Range("A2:N" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets(item).Cells(Sheets(item).Rows.Count, "A").End(xlUp).Offset(1, 0)
            ws.Range("J1").AutoFilter
        Next item
        RngList.RemoveAll
    Next ws
    Application.ScreenUpdating = True
End Sub

The macro assumes you have headers in row 1 of each of the 5 sheets and your data starts in row 2.

 

[thedeadzeds]

Thanks for that. Im getting an error on the following line. It copys Brecon fine but stops after that

ws.Range("A2:N" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets(item).Cells(Sheets(item).Rows.Count, "A").End(xlUp).Offset(1, 0)

 

[mumps]

When I tried the macro on a dummy workbook it worked properly. What is the error message when you click 'Debug'?

 

[thedeadzeds]

Apologies I'm an idiot (user error) all is working fine. Thanks very much for your help

 

[thedeadzeds]

Re: VBA Copy from multiple sheets - New error

Sorry to come back to this. I've made a few changes to the worksheet where the Name is now in column N rather than column J. I thought changing the code to the below would do the trick but i'm getting a Runtime error 1004 no cells were found.

Sub CopyRange()    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, name As Range, item As Variant, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each ws In Sheets(Array("Brecon", "Chepstow"))
        LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each name In ws.Range("N2:N" & LastRow)
            If Not RngList.exists(name.Value) Then
                RngList.Add name.Value, Nothing
            End If
        Next name
        For Each item In RngList
            ws.Range("N1:N" & LastRow).AutoFilter Field:=1, Criteria1:=item
            ws.Range("A2:N" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets(item).Cells(Sheets(item).Rows.Count, "A").End(xlUp).Offset(1, 0)
            ws.Range("N1").AutoFilter
        Next item
        RngList.RemoveAll
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[thedeadzeds]

Re: VBA Copy from multiple sheets - New error

Actually just looking at this, what i probably should have said is the data in sheets Chepstow and Brecon are querys from SQL so are essentially tables. If I copy the data from these sheets and paste as values everything works ok. Is there a way to get this to work based on the linked tables. The table names are the same ie, Chepstow and Brecon. Thanks

 

[mumps]

Re: VBA Copy from multiple sheets - New error

I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.