Macros que copie datos de un libro a otro libro, con la condición de columna, y no de filas, ya que esta cambia constantemente.
Resulta que tengo una macros que al final de el, tiene como condición un orden de filas como se muestra en la imagen.
Me preguntaba si Habría una opción de cambiar para que ese resultado solo dependa de la columna y no de la fila ya que no necesariamente el resultado total esta debajo de la fila del resultado IVA", sino que este puede cambiar sus destino de fila constantemente. Mas no su columna.
Gracias, espero contar con su apoyo.
Saludos...
1 respuesta
Respuesta de Dante Amor
E stimado, disculpa por no responder a tiempo, pero ya tengo tu macro con los cambios.
Me parece que la definitiva sería esta:
Sub Registrar()
'---
' Por.Dante Amor
'---
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet 'Hoja formato
'
libro2 = "direcciondehoja.xlsx"
existe = False
For Each libros In Workbooks
If libros.Name = libro2 Then
existe = True
Exit For
End If
Next
'
If Not existe Then
If Dir(l1.Path & "\" & libro2) <> "" Then
Workbooks.Open l1.Path & "\" & libro2
existe = True
End If
End If
If existe = False Then
MsgBox "No existe el libro: " & libro2, vbCritical
Exit Sub
End If
'
Set l2 = Workbooks(libro2)
Set h2 = l2.Sheets("hoja@.") 'Hoja destino
'
If h1.Range("H9").Value = "" Then
MsgBox "Falta la categoría", vbExclamation
Exit Sub
End If
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
i = 15
Do While h1.Cells(i, "C") <> ""
'datos de cabecera
h2.Cells(u2, "A") = h1.[H9] 'categoría
h2.Cells(u2, "B") = h1.[H7] 'fecha emisión
h2.Cells(u2, "C") = h1.[G5] 'factrura
h2.Cells(u2, "D") = h1.[H5] 'de compra
h2.Cells(u2, "E") = h1.[H8] 'atención
'
'continuar en esta parte con los demás datos
'
'datos de detalle
H2.Cells(u2, "K") = h1. Cells(i, "C") 'num fila
h2.Cells(u2, "L") = h1. Cells(i, "D") 'cant
h2.Cells(u2, "M") = h1. Cells(i, "E") 'cant
h2.Cells(u2, "N") = h1. Cells(i, "F") 'desc
h2.Cells(u2, "O") = h1. Cells(i, "G") 'pu
h2.Cells(u2, "P") = h1. Cells(i, "H") 'importe
'
'datos de resumen
h2.Cells(u2, "Q") = h1.[H37] 'sub total
h2.Cells(u2, "R") = h1.[H38] 'iva
'
'Busca TOTAL
Set b = h1.Columns("G").Find("T O T A L", lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(u2, "S") = h1.Range("H" & b.Row) 'total
End If
'
u2 = u2 + 1
i = i + 1
Loop
l2.Save 'guarda el libro2
l2.Close 'cierra el libro2
MsgBox "Datos Registrados"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
.
De cualquier forma, avísame cualquier duda.
.
