VBA Copy rows to another sheet

[Blizzardx23]

Hey everyone! Hope everybody is doing well.

I've bee searching around and I've found some threads that are similar to what I'm trying to do but small differences completely change the results.

I have a spreadsheet that is e-mailed to me daily. It has hundreds of lines that need to be separated into 7 or so sheets.

The code needs to find a specific word in "D" column (per row) to determine what sheet it copies that row to.

Example:

Tag ID	Item Number	Rate	Description
243567742	AAJ07541	E	Boat Sea
453643564	A0721421	E	Ski Sea
123452345	A0257J25	E	Boat Sea
675856788	A0257J25	C	Yacht Sea
345674577	A0D1J124	E	Car Land
536785683	A04152D2	E	Truck Land
456846657	A0D1J17J	Z	Bike Land
234523456	A222A251	E	Glider Air
244565436	A0D02424	E	Plane Air
234456425	AA1D10A2	E	Plane 2 Air
765753648	AA234FS2	E	Plane 2 Air

<colgroup><col width="151" style="width: 113pt;" span="4"> <tbody> </tbody>

It would read the information above, and move the first line for the Boat to a sheet called "Sea"..then copy the entire line for Yacht to the next line in the "Sea" sheet. Then it'll do the same for anything in Land, Air and any others that we will need to make.

OR...

If there is a way for me to have a Macro that reads what I have in "Air" sheet, it will copy any new (unmatched) Air lines from the updated/daily sheet that I receive. That would actually be best. That action would be based off the Unique Tag ID (Like the last 2 lines in my example...if the 1st "Plane 2 Air" was already listed in the "Air" sheet, it would skip that one.


Thank you everyone in advance!

 

[vcoolio]

Hello Blizzardx23,

Try the following code in a copy of your workbook first:-

Sub CreateSheetsTransferData()

        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        Dim ws As Worksheet
        Dim sh As Worksheet

Application.ScreenUpdating = False

Helper

Set sh = Sheet1 '----> Change to suit.
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("E1:E" & lr).AdvancedFilter 2, [P1], , 1 '----> Unique records only.
sh.Range("P2", sh.Range("P" & sh.Rows.Count).End(xlUp)).Sort [P2], 1 '----> Takes care of blank cells from Column E.

ar = sh.Range("P2", sh.Range("P" & sh.Rows.Count).End(xlUp)) '----> Assign to array.

For i = LBound(ar) To UBound(ar) '----> Start the loop
        If Not Evaluate("ISREF('" & ar(i, 1) & "'!A1)") Then '----> Check sheet exists.
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = ar(i, 1) '----> Add sheet if False.
        End If
        Set ws = Worksheets(CStr(ar(i, 1))) '----> Assign ws variable to sheet.
        sh.Range("E1:E" & lr).AutoFilter 1, ar(i, 1) '----> Filter.
        sh.[C1].CurrentRegion.Copy
        ws.[a1].PasteSpecial xlPasteValues '----> Transfer the data. Values only.
        ws.Columns.AutoFit
  Next i
    
sh.[E1].AutoFilter
sh.[P:P].Clear
sh.Select

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Sheets created/data transfer completed!", vbExclamation, "STATUS"

End Sub

Sub Helper()

      Dim c As Range
      Dim lr As Long
      lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
      
For Each c In Sheet1.Range("D2:D" & lr)
      c.Offset(, 1) = Right(c, Len(c) - InStrRev(c, " "))
Next c

End Sub

Its actually two codes with the main one calling the smaller one ("Helper").

The "Helper" code extracts the last part of the descriptions in Column D to Column E (land, sea, air etc....). In the main code, Column P is used to extract the unique values from Column E and then uses these unique values to create sheets (named Land, Sea etc....) and then transfer the relevant rows of data to their individual destination sheets. You'll need to create a named range for Column P first for the unique values. To do this:-

- Click on cell P1.
- Go to the Formulas tab in the ribbon.
- Select "Define Name" in the "Defined Names" group.
- In the New Name dialogue box that appears, type "Extract" (or use a name of your choice) in the name box then click OK.

I've made some notations for you in the main code just to help you understand it a little.

Hence, create a copy of your workbook, delete all sheets except your main data sheet, place the code in a standard module and assign it to a button. Test away!

Following is the link to a sample workbook I've created for you based on the data in your opening post:

http://ge.tt./7guC2su2

I've extended the data down 10K - odd rows. Click on the "RUN" button to see how it works.

I hope that this helps.

Cheerio,
vcoolio.

P.S. Actually use the following link instead.

http://ge.tt./41UG3su2