Automatically move rows to another tab based on cell value

[excel_newbie12]

Hello! I've seen posts that have provided similar help but I can't seem to make the codes provided work for me.

I'm looking to move information from the Master tab of my spreadsheet into different tabs based on Previous Company (if Column D has 'Google' then that row flows to the Google tab). I'd like to keep all rows in the Master tab.

Thank you for any help you can provide!

 

[Trebor76]

Hi excel_newbie12,

Welcome to MrExcel!!

Try this:

Option Explicit
Sub Macro1()

    Dim wsSrc As Worksheet, wsDestin As Worksheet
    Dim lngRowTo As Long, lngRow As Long, lngRowPaste As Long
    Dim strDestinTab As String
   
    Application.ScreenUpdating = False
   
    Set wsSrc = ThisWorkbook.Sheets("Master")
    lngRowTo = wsSrc.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    For lngRow = 2 To lngRowTo
        strDestinTab = Trim(wsSrc.Range("B" & lngRow))
        On Error Resume Next
            Set wsDestin = ThisWorkbook.Sheets(strDestinTab)
            If Err.Number <> 0 Then
                If wsDestin Is Nothing Then
                    'Create tab if necessary
                    ThisWorkbook.Worksheets.Add After:=Sheets(ThisWorkbook.Sheets.Count)
                    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = strDestinTab
                    Set wsDestin = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    wsSrc.Rows(1).Copy Destination:=wsDestin.Rows(1)
                End If
            End If
            lngRowPaste = wsDestin.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            wsSrc.Range("A" & lngRow & ":D" & lngRow).Copy Destination:=wsDestin.Range("A" & lngRowPaste)
        On Error GoTo 0
        Set wsDestin = Nothing
    Next lngRow
   
    Application.ScreenUpdating = True
   
    MsgBox "Records have now been copied to their respective tabs.", vbInformation

End Sub

Regards,

Robert