Macro para copiar rango de celdas

¡Hola!.
Disculpa la molestia pero necesito que me ayuden con esto: necesito copiar un rango de celdas específicas (de la A a la G) de la "hoja PRINCIPAL" a otras hojas de excel (dependiendo del tipo de dato del que se trate). La macro que utilizo es la siguiente:

Sub PasarDatos()
Application.ScreenUpdating = False
uf = Range("A65536").End(xlUp).Row
'Buscar en la fila B datos para copiarlos y pegarlos
'en la hoja correspondiente
For fil = 5 To uf
hoja = Range("B" & fil)
Rows(fil & ":" & fil).Copy
Sheets(hoja).Select
ufh = Sheets(hoja).Range("A65536").End(xlUp).Row + 1
Sheets(hoja).Rows(ufh & ":" & ufh).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PRINCIPAL").Select
Next fil
For fil = 5 To uf
hoja = Range("C" & fil)
Rows(fil & ":" & fil).Copy
Sheets(hoja).Select
ufh = Sheets(hoja).Range("A65536").End(xlUp).Row + 1
Sheets(hoja).Rows(ufh & ":" & ufh).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PRINCIPAL").Select
Next fil
'Borrar datos ya utilizados
Range("A5:B22").ClearContents
Range("B5:B22").ClearContents
Range("C5:C22").ClearContents
Range("D5:D22").ClearContents
Range("E5:E22").ClearContents
Range("F5:F22").ClearContents
Range("G5:G22").ClearContents
Range("H5:H22").ClearContents
Application.ScreenUpdating = True
End Sub
Pero lo que hace es copiar toda la fila correspondiente en las otras hojas (borrando todos los datos éstas contienen) y lo que necesito es que copie solamente las celdas especificadas.
Mil gracias.