Macro que pase datos de una hoja a otra, dependiendo una condición.

Hola buen día.

Gracias a todos por su ayuda, dsisculpen es que tengo una base de datos de la cuál quiero tomar algunos datos y pasarlos a otra hoja, eh intentado resolver con fórmulas pero las verdad no eh podido, se ve muy mal con fórmulas, lo que quiero hacer es que la hoja llamada "Basa de datos", me pase los datos a la hoja llamada "Pagos realizados", pero solo me pase las celdas que están en color verde en la hoja "Base de datos", que me pasara solo el Nombre, Fecha, Seudonimo, Producto, Método o Forma de pago, Costo de Producto y Costo de envió.

La verdad ya no se como hacerlo con macro, ojala me puedan orientar un poco, gracias por su ayuda.

Esta es la macro que eh intentado aplicar, pero no eh podido:

Sub Filtrar()

'hace que no se visualice la ejecución de la macro

Application.ScreenUpdating = False

' establece el filtro automático

Sheets("Hoja1").Select

Range("A6").Select

Selection.AutoFilter

' establece el criterio Positiva

Selection.AutoFilter Field:=14, Criteria1:="Positiva"

' ejecuta el procedimiento donde se copian los registros

' seleccionados

CopiarRegistros

Sheets("Hoja5").Select

' ejecuta el procedimiento donde se pegan los registros

' seleccionados

PegarRegistros

Sheets("Hoja1").Select

Selection.EntireColumn.Hidden = False

Range("A6").Select

' devuelve la hoja de datos a su estado original

Sheets("Hoja1").Select

Selection.EntireColumn.Hidden = False

Range("A6").Select

Selection.AutoFilter

End Sub

Sub CopiarRegistros()

Range("d:d").Select

Selection.EntireColumn.Hidden = True

Range("G:G,H:H,I:I").Select

Range("I1").Activate

Selection.EntireColumn.Hidden = True

Range("B2").Select

Selection.CurrentRegion.Select

Selection.Copy

End Sub

' se pegan los datos y se mueven las columnas a las posiciones

' deseadas

Sub PegarRegistros()

Range("A1").Select

ActiveSheet.Paste

Range("b1").Select

Range("b1", ActiveCell.End(xlDown).Address).Select

Selection.Cut

Range("f1").Select

ActiveSheet.Paste

Range("d1").Select

Range("d1", ActiveCell.End(xlDown).Address).Select

Selection.Cut

Range("b1").Select

ActiveSheet.Paste

Range("c1").Select

Range("c1", ActiveCell.End(xlDown).Address).Select

Selection.Cut

Range("g1").Select

ActiveSheet.Paste

Range("e1").Select

Selection.CurrentRegion.Select

Selection.Cut

Range("c1").Select

ActiveSheet.Paste

End Sub

Gracias por su ayuda.

Control Perfecto prueba 3.11.rar