Copiar datos de una factura a una hoja resumen o salida
Quisiera si me podrían ayudar con este código porque creo que algo estoy haciendo mal.
Sub salida()
Sheets("Remito").Select
Dim numero As Integer
numero = range("RemitoX").Value
Sheets("Salida").Select
Rows("7:7").Select
Dim i As Integer
For i = 1 To numero
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
Sheets("Remito").Select
range("RemitoX").Select
Selection.Copy
Sheets("Salida").Select
Dim b As Integer
x = 7: y = 7 + numero
Set Rng = range("A" & x & ":A" & y)
With Rng
.Select
End With
range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.NumberFormat = "X - 0000000"
' COPIANDO FECHA
Sheets("Remito").Select
range("J3").Select
Selection.Copy
Sheets("Salida").Select
range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.NumberFormat = "dd/mm/yyyy"
' COPIANDO CODIGO
Sheets("Remito").Select
range("tabla_remito[Código]").Select
Selection.Copy
Sheets("Salida").Select
range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'ActiveSheet.Hyperlinks.Add range("C9"), "Facturas/" & range("C9") & ".pdf"
' COPIANDO CODIGO CLIENTE
Sheets("Remito").Select
range("E8").Select
Selection.Copy
Sheets("Salida").Select
range("f7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
' COPIANDO CANTIDAD
Sheets("Remito").Select
range("tabla_remito[Cantidad]").Select
Selection.Copy
Sheets("Salida").Select
range("e7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("remito").Select
range("tabla_remito[Descripcion]").Select
Selection.Copy
Sheets("Salida").Select
range("c7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
' COPIANDO EN LA TABLA MOVIMIENTOS, copiamos el total de la factura
Sheets("Remito").Select
range("E31").Select
Selection.Copy
Sheets("Salida").Select
range("G7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Style = "Currency"
Selection.NumberFormat = "$ #,##0.00"
End Sub
Este código en teoría tendría que hacer lo siguiente:
Copiar el Nº de remito, la fecha el id del cliente, y la compra realizada ( código producto, descripción, cantidad, precio por unidad, precio total de cada producto y monto de la factura) y llevarlo uno de bajo del otro a una planilla llamada "Salida" pero me aparece asi:
1 Respuesta
Te anexo una nueva macro, prueba y me comentas.
Sub Enviar_Salida()
' Por Dante Amor
Set h1 = Sheets("Remito")
Set h2 = Sheets("Salida")
'
i = 13
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
Do While h1.Cells(i, "A") <> ""
h2.Cells(u2, "A") = h1.Range("B8") 'Remito
h2.Cells(u2, "B") = h1.Cells(i, "A") 'cod
h2.Cells(u2, "C") = h1.Cells(i, "B") 'desc
h2.Cells(u2, "D") = h1.Range("J3") 'fecha
h2.Cells(u2, "E") = h1.Cells(i, "C") 'cantidad
h2.Cells(u2, "F") = h1.Range("E8") 'cliente
h2.Cells(u2, "G") = h1.Cells(i, "E") 'monto
u2 = u2 + 1
i = i + 1
Loop
MsgBox "Datos enviados a la hoja salida"
End SubNota: Pon en la hoja salida, en cada columna el formato que necesites.
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Feliz Año 2018
.
Hola Dante Recién veo tu código. Me funciona a la perfección salvo que me los copia casi en la ultima fila de la tabla. y por lo que veo lo que hace que me lo envíe abajo es la función end(xlup)
se puede hacer que pegue los datos en la hoja salida al principio de la tabla?. Desde ya muchas gracias
Te anexo la macro actualizada
Sub Enviar_Salida()
' Por Dante Amor
Set h1 = Sheets("Remito")
Set h2 = Sheets("Salida")
'
i = 13
u2 = 7
Do While h1.Cells(i, "A") <> ""
h2.Rows(7).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
h2.Cells(u2, "A") = h1.Range("B8") 'Remito
h2.Cells(u2, "B") = h1.Cells(i, "A") 'cod
h2.Cells(u2, "C") = h1.Cells(i, "B") 'desc
h2.Cells(u2, "D") = h1.Range("J3") 'fecha
h2.Cells(u2, "E") = h1.Cells(i, "C") 'cantidad
h2.Cells(u2, "F") = h1.Range("E8") 'cliente
h2.Cells(u2, "G") = h1.Cells(i, "E") 'monto
i = i + 1
Loop
MsgBox "Datos enviados a la hoja salida"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Feliz Año 2018
.
