Macros que copie Datos de una HojaY a otro Libro de HojaX, y a esta copiarla sin importar que este abierta o cerrada y guardarla
Para Dante Amor, Buenos días mi Estimado. Espero me puedas ayudar con esta pregunta.
GRacias.
En referencia a mi anterior pregunta, Macros que copie datos específicos de una HojaY a otro Libro HojaX y las ordene una debajo de otra en filas consecutivas. Quería saber si se puede hacer lo mismo, pero con el libro de destino estando cerrado o abierto, y que luego la cierre. Guardando la información al REGISTRARSE.
* ¿Y en esta parte de la macros como?' se editaría, para que la macro reconozca el resultado QUE ESTA A LADO DEL TEXTO "TOTAL", es decir "el valor numérico"
En la hoja macros, entiendo que el Valor numérico depende de la fila y columna, como el de la imagen adjunto. [ h39 ], habría???
Imagen inicial.
Imagen de Ahora.
Habria 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.
1 Respuesta
Te anexo la macro actualizada con lo siguiente:
- Si el libro2 está abierto, continúa la macro
- Si no está abierto el libro2 lo busca en el mismo directorio donde está la macro
- Si existe el libro2, lo abre, si no existe envía un mensaje y se detiene la macro
- Verifica en la columna "G" la palabra "T O T A L", si existe obtiene el total, si no existe no obtiene nada
- Guarda el libro2 y lo cierra
Sub Registrar()
'---
' Por.Dante Amor
'---
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("HojaY") 'Hoja formato
'
libro2 = "libro destino.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("HojaX") '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
.
Avísame cualquier duda
.
Buenas tardes, tengo un inconveniente, respecto en esta parte de la macros ya que se detiene y se pone en colo amarillo, ¿acaso tendría que remplazar algo ahí?
If Dir(l1.Path & "\" & libro2) <> "" Then Workbooks.Open l1.Path & "\" & libro2
disculpa la molestia, crees que te lo puedo enviar a tu correo ?, la hoja excel que tengo.?
Qué mensaje te envía y en cuál línea se detiene.
Sí, envíame tu archivo, recuerda poner tu nombre de usuario en el asunto del correo
¡Gracias!
Mi estimado cual seria tu correo electrónico.
Saludos.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “robert farfan” y el título de esta pregunta.
