Macro que copie datos de dos hojas y valores constantes a otra hoja de excel
Me gustaría que me ayudes con la siguiente solicitud. Tengo una hoja destino llamada "Colpatria". En dicha hoja tengo lo siguiente:
En la fila (1y2) y en la fila (5Y6) tengo los siguientes encabezados.
A:Fecha B:Tipo ID C:Numero ID D:Nombres y Apellidos E:Servicio Atendido F:Diagnóstico G:V. Bruto H:Copago I:V. Neto
Los datos contenidos en esta hoja provienen de la hoja "Ing Colpatria" de la siguiente manera:
Fecha en la celda "G10"
Tipo de ID en la celda "G12"
Numero ID en la celda "G8"
Nombres y Apellidos en la celda "G14"
Servicio Atendido en la celda "G16"
Si "G16" es "Consulta" debe poner en la columna "G" de V. Bruto el valor de "45870" pero si es "Control" debe colocar "38430" y si es diferente a los anteriores entonces se deja vacío.
Copago en la celda "G18"
La dificultad de este ejercicio consiste en que cuando "G16" es "CONSULTA" o "CONTROL" los debe ir agregando en la siguiente fila vacia debajo del primer encabezado.
Cuando "G16" es diferente a "CONSULTA" o "CONTROL" los debe ir agregando en la siguiente fila vacia debajo del segundo encabezado.
Tener en cuenta que a medida que se van agrendo Items debajo del primer encabezado, eso hace que el segundo encabezado igualmente se vaya desplazando hacia abajo.
Espero me halla hecho comprender y me puedas ayudar.
Te mando una imagen para que me comprendas mejor:
1 Respuesta
H o l a:
Te anexo la macro
Sub CopiarDatos()
'Por.Dante Amor
Set h1 = Sheets("ing colpatria")
Set h2 = Sheets("colpatria")
'
If UCase(h1.[G16]) = "CONSULTA" Or UCase(h1.[G16]) = "CONTROL" Then
If UCase(h1.[G16]) = "CONSULTA" Then vbruto = "45870" Else vbruto = "38430"
u = 3
Do While h2.Cells(u, "A") <> ""
u = u + 1
Loop
h2.Rows(u).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Else
vbruto = ""
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
End If
'
h2.Cells(u, "A") = h1.[G10]
h2.Cells(u, "B") = h1.[G12]
h2.Cells(u, "C") = h1.[G8]
h2.Cells(u, "D") = h1.[G14]
h2.Cells(u, "E") = h1.[G16]
h2.Cells(u, "G") = vbruto
h2.Cells(u, "H") = h1.[G18]
MsgBox "Datos copiados"
End SubS a l u d o s
