Need VBA to auto copy data from one sheet to specific on based of Staus

I have an excel file with 06 worksheets. I fill data in 01 sheet "Data". I want that on the basis of 'Status column' on 'Data sheet' the data automatically copies to their respective sheets.

Technology RBO ITEM Qty Estimated Value Customer Status
Litho Sears Belly Bands 60,000 $6,000.00 abc Universe
Litho Target-Threshold Belly Band 60,000 $5,000.00 abc Above Funnel
HTL Target-Threshold HTL 60,000 $54,000.00 abc In Funnel
FG Aeropostale Pico Patch 60,000 $54,000.00 def Best Few

urgent help required to do this task.

The first of your two lines explained what you want, but then below you have included some data with no explanation.

Add the sub & function and run CopyonStatus

Public Sub CopyonStatus()
Dim lastR As Long
Dim lR As Long
Dim i As Integer
Dim sName As String
Sheets("Data").Select
lastR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastR
    sName = Cells(i, 7)
    lR = getLR(sName)
    Sheets(sName).Cells(lR, 1).Resize(1, 6).Value = Range(Cells(i, 1), Cells(i, 6)).Value
Next i
End Sub

Public Function getLR(shtName As String) As Long
    With Sheets(shtName)
        getLR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    End With
End Function

If the task is simpley to create tabs, here is another option

Sub craetenames()
Dim i As Long, LR As Long, NR As Long, nome As String, sh As Worksheet, ws As Worksheet

    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Data" And ws.Name <> "Summary" Then
            ws.Cells.ClearContents
        End If
    Next
    Set sh = ThisWorkbook.Worksheets("Data")
    LR = sh.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To LR
    On Error Resume Next
        nome = Trim(sh.Range("G" & i).Value)
        If Not Evaluate("ISREF('" & nome & "'!A1)") Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = nome
        End If
        NR = Worksheets(nome).Range("A" & Rows.Count).End(xlUp).Row + 1
        sh.Rows(i).Copy Worksheets(nome).Range("A" & NR)
        sh.Range("A1:F1").Copy Worksheets(nome).Range("A1")
    Next i
    Columns("A:F").EntireColumn.AutoFit
    Application.ScreenUpdating = True

End Sub

Dear AB and Tony,

This will not resolve my issue.
I am explaining here the detail.

I have 04 sheets named 'Best Few', 'In Funnel', 'Above Funnel', 'Universe'.
The 'Universe' sheet have all the rough data with the Status same as Sheet name.
What i want that on the basis of that status the row data will auto copy into their respective tab.
Kindly see the attached sheet for more clarification.

Thanks and regards for help.

Nadeem,
My code creates individual tabs for each status in column "G". I do not know what you mean by auto. The code clears existsing data in each tab and then populate them with fresh data. All you need to do is press a button to run a macro. If this is not what you are after, I shall wait for the others to chip in.

Dear TonyS,

Your Macro code works really well. Just need to addon one more thing in this code that before copy data it is not clear the previous content. It again copy data.
Kindly add the code to clear data from row 2 to onwards before copying to sheet.

thanks.

Change to

Public Sub CopyonStatus()
Dim lastR As Long
Dim lR As Long
Dim i As Integer
Dim sName As String
Dim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "Data" And ws.Name <> "Summary" Then
        ws.Rows("2:" & Rows.Count).ClearContents
    End If
Next

Sheets("Data").Select
lastR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastR
    sName = Cells(i, 7)
    lR = getLR(sName)
    Sheets(sName).Cells(lR, 1).Resize(1, 6).Value = Range(Cells(i, 1), Cells(i, 6)).Value
Next i
End Sub