Need help with a worksheet please

[Stevenson500]

I have a "Master Inventory Worksheet" that I need to subcategorize into route planners by county. I need the sub worksheet to lookup a cell in the master and if that cell has the correct county, I need the line data, which is in cell format, to populate into the sub worksheet. So, If the "King County" sub WS goes to the Master Inventory Sheet" and find the word "King" in cell K1, then the data in Line 1 of the Master will populate to the sub worksheet in Line 1. I will then copy it down the worksheet so it populates all subsequent lines that Has the word "King" in column K. And so on for all the counties that travel in for work . I am looking for the formula that I can copy throughout the sub WS. Thanks in advance

 

[Logit]

If you are comfortable giving it a try on your own, the following macro will take care of the job (from what I understand of your request):

Option Explicit


Sub CreateSheets()


    Dim Cell    As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet


        Set RngBeg = Worksheets("Sheet1").Range("K2")
        Set RngEnd = Worksheets("Sheet1").Cells(Rows.Count, "K").End(xlUp)


        ' Exit if the list is empty.
        If RngEnd.Row < RngBeg.Row Then Exit Sub
Application.ScreenUpdating = False
        For Each Cell In Worksheets("Sheet1").Range(RngBeg, RngEnd)
            On Error Resume Next
                ' No error means the worksheet exists.
                Set Wks = Worksheets(Format(Cell.Value, "[$-409]mmm;@"))


                ' Add a new worksheet and name it.
                If Err <> 0 Then
                    Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    Wks.Name = Format(Cell.Value, "[$-409]mmm;@")
                End If
            On Error GoTo 0
        Next Cell
Application.ScreenUpdating = True


MakeHeaders
End Sub


Sub MakeHeaders()
Dim srcSheet As String
Dim dst As Integer
srcSheet = "Sheet1"
Application.ScreenUpdating = False
For dst = 1 To Sheets.Count
    If Sheets(dst).Name <> srcSheet Then
    Sheets(srcSheet).Rows("1:1").Copy
    Sheets(dst).Activate
    Sheets(dst).Range("A1").PasteSpecial xlPasteValues
    'ActiveSheet.PasteSpecial xlPasteValues
    Sheets(dst).Range("A1").Select
    End If
Next
Application.ScreenUpdating = True
CopyData
End Sub


Sub CopyData()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
On Error Resume Next
Lastrow = Sheets("Sheet1").Cells(Rows.Count, "K").End(xlUp).Row
Dim ans As String
Dim ans2 As String


NoVisi


    For i = 2 To Lastrow
    ans = Sheets("Sheet1").Cells(i, 11).Value
    ans2 = Format(ans, "[$-409]mmm;@")
        Sheets("Sheet1").Rows(i).Copy Sheets(ans2).Rows(Sheets(ans2).Cells(Rows.Count, "A").End(xlUp).Row + 1)
    Next
    
Visi


Application.ScreenUpdating = True


Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A1").Select


Exit Sub


Application.ScreenUpdating = True


End Sub


Sub NoVisi()
Dim CommandButton1 As Object


CommandButton1.Visible = False


End Sub


Sub Visi()
Dim CommandButton1 As Object


CommandButton1.Visible = True
End Sub