Transfer lines to tab that matches column D

[surkdidat]

HI

Hope someone can help me.... I am guessing its some sort of INDIRECT, but not sure how exactly I go about it

I have the below example table. This is in a tab called "MAIN"

Also, I have tabs called "Team_A" "Team_B" "Team_C" etc.

These names are in Column D on the MAIN tab

What I need to do is have something that will extract all the lines to the correct tab.

(On my real data there are currently around 200 lines and 7 tabs, but more data will be added as I go along, so not really practical to filter and cut and paste as I want the data to be in real time, and not have anything missed.

Thanks

	Column A	Column B	Column C	Column D (TAB NAMES)
	Adam	Smith	Blue	TEAM_A
	Peter	Jones	Blue	TEAM_A
	Steven	Hayes	Green	TEAM_C
	Peter	Caddick	Orange	TEAM_A
	Andrew	Bell	Orange	TEAM_B
	Tim	Lovejoy		TEAM_D

 

[vcoolio]

Hello Surkdidat,

Try the following VBA code placed into a standard module and assigned to a button on your "MAIN" sheet:-

Sub Test()

        Dim ar As Variant, wsM As Worksheet, wsT As Worksheet
        Set wsM = Sheets("MAIN")
        ar = Array("TEAM_A", "TEAM_B", "TEAM_C", "TEAM_D")

Application.ScreenUpdating = False

        For i = 0 To UBound(ar)
                Set wsT = Sheets(ar(i))
                With wsM.[A1].CurrentRegion
                        .AutoFilter 4, ar(i)
                        .Offset(1).EntireRow.Copy wsT.Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                End With
        Next i

Application.ScreenUpdating = True

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[surkdidat]

Apologies, I should have said the first row of data starts in cell A4

 

[vcoolio]

Is row 4 headings with data starting in row 5?

 

[surkdidat]

Is row 4 headings with data starting in row 5?

Row 3 headings, row 4 data ?

 

[vcoolio]

Here you go Surkdidat:-

Sub Test()

        Dim ar As Variant, wsM As Worksheet, wsT As Worksheet
        Set wsM = Sheets("MAIN")
        ar = Array("TEAM_A", "TEAM_B", "TEAM_C", "TEAM_D") '---->Add sheet names as required.

Application.ScreenUpdating = False

        For i = 0 To UBound(ar)
                Set wsT = Sheets(ar(i))
                With wsM.Range("D3", wsM.Range("D" & wsM.Rows.Count).End(xlUp))
                        .AutoFilter 1, ar(i)
                        .Offset(1).EntireRow.Copy wsT.Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                End With
        Next i

Application.ScreenUpdating = True

End Sub

Cheerio,
vcoolio.