Te anexo un ejemplo
Sub Copiar_Registros()
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
For i = 2 To h1.Range("D" & Rows.Count).End(xlUp).Row
hoja = LCase(h1.Cells(i, "D").Value)
Select Case hoja
Case "archivo1": Set h2 = Sheets("archivo1")
Case "archivo2": Set h2 = Sheets("archivo2")
Case "archivo3": Set h2 = Sheets("archivo3")
End Select
'Copia y pega cada registro en la hoja correspondiente
u2 = h2.Range("D" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy
h2.Rows(u2).PasteSpecial xlValues
Next
'Imprimir hojas
'
Sheets("archivo1"). PrintOut
Sheets("archivo2"). PrintOut
Sheets("archivo3"). PrintOut
'
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
Ahora bien, si el contenido de la celda es igual nombre de la hoja, no necesitas un Case, solamente lo pones como nombre de hoja, ejemplo:
Sub Copiar_Registros2()
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
For i = 2 To h1.Range("D" & Rows.Count).End(xlUp).Row
hoja = LCase(h1.Cells(i, "D").Value)
Set h2 = Sheets(hoja)
'Copia y pega cada registro en la hoja correspondiente
u2 = h2.Range("D" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy
h2.Rows(u2).PasteSpecial xlValues
Next
'Imprimir hojas
'
Sheets("archivo1"). PrintOut
Sheets("archivo2"). PrintOut
Sheets("archivo3"). PrintOut
'
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.
'.[Avísame cualquier duda