Perfeccionar Macro existente incluyendo formulas
Tu me ayudaste con la siguiente Macro, pero quisiera mejorarla en unos aspectos que tengo nuevos. La macro es esta:
Sub CopiarDatosColpatria()
'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]
h2.Cells(u, "I") = "=IF(RC[-2]="""","""",RC[-2]-RC[-1])"
MsgBox "Datos copiados"
End SubCuando la celda "G16" es CONSULTA ó CONTROL deseo que siga haciendo lo mismo que hace actualmente, pues lo esta haciendo muy bien.
Cuando por el contrario el contenido de la celda "G16" es un código numérico ejemplo "860101" entonces debe buscar este valor en la hoja "CONSTANTES" en la columna "AV" y cuando lo encuentre debe tomar el valor correspondiente que se encuentre en la misma fila de la siguiente manera:
Si la celda "G20" es "ORIGINAL" entonces debe tomar el contenido de la misma fila de la 4ta columna hacia la derecha de "AV" pero si "G20" es "ALTERNO" debe tomar el contenido de la misma fila de la 9a columna hacia la derecha de "AV". Este valor es el que debe colocar en h2.Cells(u, "G").
Esto sigue igual: h2.Cells(u, "H") = h1.[G18]
Y en la siguiente instrucción: h2.Cells(u, "I") = "=IF(RC[-2]="""","""",RC[-2]-RC[-1])"
Para el caso de "CONSULTA" o "CONTROL" sigue igual pero para el caso de cualquier código número en "G16" entonces debe hacer lo mismo pero multiplicado por lo contenido en la celda de la columna "J" de la misma fila en donde se esta registrando:
No se como se escriba pero algo asi como:
h2.Cells(u, "I") = "=IF(RC[-2]="""","""",(RC[-2]-RC[-1])*la columna "J" de la misma fila)"
2 Respuestas
H o l a:
No me pusiste en cuál encabezado se debe registrar cuando G16 es numérico.
Lo estoy poniendo en el encabezado 2.
Te anexo la macro.
Sub CopiarDatos()
'Por.Dante Amor
Set h1 = Sheets("ing colpatria")
Set h2 = Sheets("colpatria")
Set h3 = Sheets("CONSTANTES")
'
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
laformula = "=IF(RC[-2]="""","""",RC[-2]-RC[-1])"
ElseIf IsNumeric(h1.[G16]) Then
Set b = h3.Columns("AV").Find(h1.[G16], lookat:=xlWhole)
If Not b Is Nothing Then
If UCase(h1.[G20]) = "ORIGINAL" Then
vbruto = b.Offset(0, 4)
ElseIf UCase(h1.[G20]) = "ALTERNO" Then
vbruto = b.Offset(0, 9)
End If
End If
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
laformula = "=IF(RC[-2]="""","""",(RC[-2]-RC[-1])*RC[1])"
Else
vbruto = ""
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
laformula = ""
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]
h2.Cells(u, "I") = laformula
MsgBox "Datos copiados"
End SubSi quieres que vaya en el encabezado 1:
Sub CopiarDatos()
'Por.Dante Amor
Set h1 = Sheets("ing colpatria")
Set h2 = Sheets("colpatria")
Set h3 = Sheets("CONSTANTES")
'
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
laformula = "=IF(RC[-2]="""","""",RC[-2]-RC[-1])"
ElseIf IsNumeric(h1.[G16]) Then
Set b = h3.Columns("AV").Find(h1.[G16], lookat:=xlWhole)
If Not b Is Nothing Then
If UCase(h1.[G20]) = "ORIGINAL" Then
vbruto = b.Offset(0, 4)
ElseIf UCase(h1.[G20]) = "ALTERNO" Then
vbruto = b.Offset(0, 9)
End If
End If
'u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
u = 3
Do While h2.Cells(u, "A") <> ""
u = u + 1
Loop
h2.Rows(u).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'
laformula = "=IF(RC[-2]="""","""",(RC[-2]-RC[-1])*RC[1])"
Else
vbruto = ""
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
laformula = ""
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]
h2.Cells(u, "I") = laformula
MsgBox "Datos copiados"
End Subs a l u d o s
