Copy/Paste with no blank rows

[craig2525]

Sheet 1 Sheet 2 Sheet 3 Sheet 4

How can I copy/paste the raw data from Sheet 1 to Sheets 2, 3 and 4? I am inputting the raw data into Sheet 1 and would like to automatically copy/paste into separate sheets according to the name in Sheet 1 column 1 (as shown)? I have no experience with VBA.

 

[Logit]

Here is a shorter method :

Sub ExtractToSheets()
    Dim ws     As Worksheet
    Dim wsNew  As Worksheet
    Dim rData  As Range
    Dim rfl    As Range
    Dim state  As String
    Set ws = ThisWorkbook.Sheets("Sheet1")
   
    With ws
        Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 11).End(xlUp))
        .Columns(.Columns.Count).Clear
        .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
       
        For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
            state = rfl.Text
           
            If WksExists(state) Then
               Sheets(state).Cells.Clear
            Else
               
                Set wsNew = Sheets.Add
                wsNew.Move After:=Worksheets(Worksheets.Count)
                wsNew.Name = state
            End If
           
            rData.AutoFilter Field:=6, Criteria1:=state
            rData.Copy Destination:=Worksheets(state).Cells(1, 1)
        Next rfl
    End With
    ws.Columns(Columns.Count).ClearContents
    rData.AutoFilter
End Sub
 
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

 

[Radoslaw Poprawski]

does the 1st column cointains static number of unique entries?

 

[craig2525]

It would be a copy and paste from another sheet I download.

 

[craig2525]

Works great Logit!!! Thank you very much!!!

 

[Logit]

You are welcome. I finally understood what you were looking for ... DUH ! Slap my forehead and call me dumb.

Cheers !!!