VBA to copy rows from worksheet to multiple other worksheets based on cell data

[LFaz268710]

Hi,
I have a workbook that contains the details of customers booked for different trips on sheet 2

I want to copy the rows from sheet 2 to different sheets based on the location, e.g. all customers booked for Nice will copy to sheet 3, all for Mallorca will go to sheet 4 etc.

Is a VBA the only way to do this? I need to make sure it doesn't delete the data on sheet 2, but I'm struggling with the standard copy code as I can't work out how to ensure each additional sheet only pulls the particular location over. Do I have to have a VBA module for each location?

Many thanks,

 

[mumps]

We would need to know in which column in sheet2 the location is listed. Also, do the destination sheets already exist or do they have to be created?

 

[LFaz268710]

So quick! The location column in sheet2 is D:D

The destination sheets exist already - basically, sheet2 is like the master where all order bookings get listed as they come in, then it needs to copy to the other worksheets. The other sheets are monitored to make sure they don't get way too many bookings for one destination

 

[mumps]

Are the other sheets named according to location? For example, the sheet name for location "Nice" is named "Nice".

 

[LFaz268710]

They are named according to the location and date of trip so "Nice 13th Jun 2021" - as the cell value to look up is the exact same e.g. would say in column D Nice 13th Jun 2021

 

[mumps]

Try this macro. It assumes you have headers in row 1 and the data starts in row 2. Change the sheet name (in red) to suit your needs.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, v As Variant, srcWS As Worksheet, dic As Object, key As Variant
    Set srcWS = Sheets("Summary")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = srcWS.Range("D2", srcWS.Range("D" & srcWS.Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v)
        If Not dic.Exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
        End If
    Next i
    For Each key In dic.keys
        With srcWS
            .Range("A1").AutoFilter 4, key
            .AutoFilter.Range.Offset(1).Copy Sheets(key).Cells(Sheets(key).Rows.Count, "A").End(xlUp).Offset(1)
        End With
    Next key
    srcWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[LFaz268710]

Thank you - amended the summary sheet name accordingly but getting a runtime error (9)
Debug says error is with this line

.AutoFilter.Range.Offset(1).Copy Sheets(key).Cells(Sheets(key).Rows.Count, "A").End(xlUp).Offset(1)

It just seems to be filtering sheet2 with the bookings for the first location in the list, and pulling all the others with that location together in sheet2, hiding the other rows.

 

[mumps]

It is hard to test code without seeing your actual file. 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.

 

[LFaz268710]

Thank you - here is a copy Peddle Pickup Overview 2021 1.xlsm

 

[mumps]

The first problem was that the sheet name (in red) in the code wasn't changed to "CRM" as I suggested in Post #6. The second problem is that you said the sheet names were:

named according to the location and date of trip so "Nice 13th Jun 2021"

Most of the event names in column D of "CRM" are not named using the full date and some do not have a date at all. Others cells in column D are blank. Could you please clarify how you want to handle the events without a full date or with no date all as part of their name. I assume you want to ignore those events that are blank in column D. Is this correct?