Move Rows of Data from a Specific Column (Based on Matching Criteria) to a new Sheet

[jordan1214]

Hello, I attached a sample workbook to try and further explain my question.

So, in the "Info" sheet I want to move all of the cells based on the criteria of Column B.

So, I want to copy Row 2 to the "One" Sheet because it has the word "One" in Column B.

Basically I want to be able to change the data in the "Info" sheet and it move to the other sheet's based on that Column B criteria.

There are 4 more sheets, but really as long as I figure out how to do this one example, I can apply it to the rest in the sample workbook.

Thanks again for any help!

[Trebor76]

Hi jordan1214,

Try this:

Option Explicit
Sub Macro2()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim varMyTabLen As Variant
    Dim lngMyRow As Long
    Dim rngCell As Range
    
    Application.ScreenUpdating = False
    
    For Each rngCell In Sheets("Info").Range("B2", Range("B" & Rows.Count).End(xlUp))
    
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then
                If WorksheetFunction.CountA(CStr(rngCell)) = 0 Then
                    lngMyRow = 2 'Default row number if there's no data. Change to suit.
                Else
                    lngMyRow = Sheets(CStr(rngCell)).Range("A:P").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                End If
            Sheets(CStr(rngCell)).Range("A" & lngMyRow & ":P" & lngMyRow).Value = Sheets("Info").Range("A" & rngCell.Row & ":P" & rngCell.Row).Value
            End If
            Err.Clear
        On Error GoTo 0
    
    Next rngCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is complete"
    
End Sub

Note, as there a space after each "One" in column B of the "Info" tab, these rows will not be transferred to the "One" tab as the names must be exact for the code to work.

Regards,

Robert