How do you pull data from one sheet to 3 other sheets based on specific column values?

Question

I would like to know how can one pull data with VBA from one sheet to the other 3 sheets based on the value one column has.

For Example.

You have 4 Sheets. Tree1, Tree2, Tree3, Data

Tree1, Tree2, and Tree3 have different columns of data. Sheet 4 which is called data has different columns of data but the 1 column's values are "TreeOne", "TreeTwo", and "TreeThree".

I would like to formula to pull from the datasheet each respective tree's data based on that one column from the Datasheet.

 Example of the "Data" Sheet

 |Colour| Bark| Hight| Season| Specie|
 | Brown| Soft| 10   | Summer| Tree 1|
 | Brown| hard| 12   | Winter| Tree 2|
 | Brown| hard| 14   | Summer| Tree 1|
 | Brown| soft| 12   | Winter| Tree 3|
 | Brown| hard| 11   | Summer| Tree 2|

So the query should pull from the "Data" Sheet into each specific sheet based on the "Specie" column.

 Example of the "TreeOne" Sheet

 |Colour| Bark| Hight| Season| Specie|
 | Brown| Soft| 10   | Summer| Tree 1|
 | Brown| hard| 14   | Summer| Tree 1|


 Example of the "TreeTwo" Sheet

 |Colour| Bark| Hight| Season| Specie| 
 | Brown| hard| 12   | Winter| Tree 2|
 | Brown| hard| 11   | Summer| Tree 2|


  Example of the "TreeThree" Sheet

 |Colour| Bark| Hight| Season| Specie|
 | Brown| soft| 12   | Winter| Tree 3|

As you can see the VBA query looks at the "Specie" Column and based on the specific species, pulls all the data of that Species to the sheet indicated for that data.

Answer 1

Option Explicit

Sub ClearData(rngSpecies As Range)
    Dim uniqueSpecie As String
    Dim rngSpecie As Range
    Dim aux As Long
    
    For Each rngSpecie In rngSpecies
        If InStr(1, uniqueSpecie, rngSpecie.Value, vbTextCompare) = 0 Then
            On Error Resume Next
            aux = ThisWorkbook.Worksheets(rngSpecie.Value).Index
            If Err.Number = 9 Then
                rngSpecie.Activate
                MsgBox "Worksheet '" & rngSpecie.Value & "' doesn't exist. Error in cell " & rngSpecie.Address
                Exit Sub
            End If
            uniqueSpecie = uniqueSpecie & rngSpecie.Value & ";"
        End If
    Next
    If uniqueSpecie <> "" Then
        uniqueSpecie = Left(uniqueSpecie, Len(uniqueSpecie) - 1)
    End If
    
    Dim aSpecies As Variant
    aSpecies = Split(uniqueSpecie, ";")
    
    Dim i As Long
    For i = LBound(aSpecies) To UBound(aSpecies)
        ThisWorkbook.Worksheets(aSpecies(i)).Range("A:E").EntireColumn.ClearContents
        'Set the header
        ThisWorkbook.Worksheets(aSpecies(i)).Range("A1:E1").Value = ThisWorkbook.Worksheets("data").Range("A1:E1").Value
    Next i
End Sub

Sub CopyData()
    Dim shtData As Worksheet
    Set shtData = ThisWorkbook.Worksheets("data")
    'Clear old data ans sets the header
    ClearData shtData.Range("E2:E" & ThisWorkbook.Worksheets("data").Range("E2").End(xlDown).Row)
    Dim i As Long, j As Long 'i = actual row in data sheet, j = new row in species sheet
    i = 2
    
    Do While shtData.Cells(i, 5) <> "" 'species
        j = ThisWorkbook.Worksheets(CStr(shtData.Cells(i, 5))).Range("A1048576").End(xlUp).Offset(1, 0).Row
        'this does the trick
        ThisWorkbook.Worksheets(CStr(shtData.Cells(i, 5))).Range("A" & j & ":E" & j).Value = _
                     ThisWorkbook.Worksheets("data").Range("A" & i & ":E" & i).Value
        i = i + 1
    Loop
    MsgBox "Done"
End Sub