Query Formula Excel - Come copiare automaticamente i dati su fogli specifici

Domanda di Microsoft Excel:

Come posso copiare automaticamente determinati dati da un foglio principale / principale ad altri fogli specificati?

E.G - Scheda principale registra tutti i dati. Vorrei che ogni riga di dati fosse copiata sul foglio corrispondente. I dati vanno al foglio rosso / blu / verde a seconda di ciò che viene inserito nelle celle per la colonna D.

Modifica: immagine allegata di seguito per cercare di illustrare ciò che sto dicendo meglio.

La seguente macro divide il foglio principale in gruppi. Il numero di colonne e righe è insignificante. Solo l'ultima colonna è importante in quanto la macro si basa sulla mappatura tra il nome del foglio e il nome del codice. Se il foglio con un determinato valore di codice non esiste, il record rimarrà intatto nel foglio principale. Come deve avere il nome in codice deve essere nell'ultima colonna.

Option Explicit
'Assumptions:
'The Code is in the last column
Sub DataSplitter()
Application.ScreenUpdating = False
On Error Resume Next
Dim noOfRows As Long
Dim noOfColumns As Long
Dim noOfRowsInCodeSheet As Variant
Dim i As Long 'counter
Dim j As Long 'counter
Dim sE As Boolean 'sheet exists flag
Dim sheetEmpy As Boolean
Dim code As String
Dim c As New Collection 'store noOfRowsInCodeSheet
Dim cRows As New Collection 'rows to delete

j = 1
'check how many columns
Do While Len(Cells(1, j).Value) > 0
j = j + 1
Loop
noOfColumns = j - 1

'check how many rows
i = 1
Do While Len(Cells(i, 1).Value) > 0
    i = i + 1
Loop
noOfRows = i - 1

'loop through the data
For i = 2 To noOfRows
    code = Cells(i, noOfColumns).Value
    'check if sheet exists
    If Sheets(code) Is Nothing Then
        sE = False ' sheet with code name does not exist
    Else
        sE = True ' sheet with code name exists
    End If
    'if sheet exists then check the noOfRows based on code
    If sE = True Then
        noOfRowsInCodeSheet = c.Item(code)
        If noOfRowsInCodeSheet Is Empty Then
            'the sheet was not visited during this execution
            'check no of rows in code sheet
            j = 1
            Do While Len(Sheets(code).Cells(j, 1).Value) > 0
                j = j + 1
            Loop
            noOfRowsInCodeSheet = j - 1
            If noOfRowsInCodeSheet = 0 Then
                'add headers
                For j = 0 To noOfColumns
                    Sheets(code).Cells(1, j).Value = Cells(1, j).Value
                Next j
                noOfRowsInCodeSheet = noOfRowsInCodeSheet + 1
            End If
            If noOfRowsInCodeSheet >= 1 Then
                noOfRowsInCodeSheet = noOfRowsInCodeSheet + 1
                'populate rows
                For j = 1 To noOfColumns
                    'Sheets(code).Cells(noOfRowsInCodeSheet, j).Value = Cells(i, j).Value 'it works but looses formatting
                    Cells(i, j).Copy
                    Sheets(code).Cells(noOfRowsInCodeSheet, j).PasteSpecial Paste:=xlPasteFormats
                    Sheets(code).Cells(noOfRowsInCodeSheet, j).PasteSpecial Paste:=xlPasteValues
                    Application.CutCopyMode = False
                Next j
                c.Remove code
                c.Add Item:=noOfRowsInCodeSheet, Key:=code
                cRows.Add Item:=i, Key:=CStr(i)
            End If
        End If
    Else
        'if sheet does not exist then do nothing (it's possible to _
        'automatically add it if required)
    End If
Next i

‘Uncomment to MOVE (cut-paste) rows (3 below lines)
‘Comment to COPY (copy-paste) rows (3 below lines)
For j = cRows.Count To 1 Step -1
    Rows(cRows.Item(j)).EntireRow.Delete
Next j

Application.ScreenUpdating = True
End Sub