Modificar la Macro copiar datos de una hoja a otra
Aquí pidiendo nuevamente tu ayuda, espero se pueda :)
Me haz ayudado con la siguiente macro:
Sub Copiar_De_Compras_A_BD()
' Por Dante Amor
Set h1 = Sheets("COMPRAS") 'Origen
Set h2 = Sheets("BD") 'Destino
h2.Rows("9:9").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
h2.Range("A9").Value = h1.Range("D4")
h2.Range("B9").Value = h1.Range("D6")
h2.Range("C9").Value = h1.Range("I6")
h2.Range("D9").Value = h1.Range("D8")
h2.Range("E9").Value = h1.Range("I8")
h2.Range("F9").Value = h1.Range("D12")
h2.Range("G9").Value = h1.Range("D14")
h2.Range("H9").Value = h1.Range("I12")
h2.Range("J9").Value = h1.Range("I14")
h2.Range("I9").Value = h1.Range("D16")
h2.Range("L9").Value = h1.Range("I16")
h2.Range("K9").Value = h1.Range("D18")
h2.Range("M9").Value = h1.Range("D20")
MsgBox "Datos copiados"
End Sub
Sin embargo, he decidido cambiar la forma en que se registran los datos, ya no en un solo reglón, sino ahora en los que indique en la celda I8 de la hoja COMPRAS.
Si indico 20 en dicha celda, quiero que registre 20 renglones con los mismos datos.
1 Respuesta
si claro.
Aqui esta la hoja "COMPRAS" asi ingreso mis datos
en la hoja BD me registra así mis datos
Y ahora quiero que los registre de esta forma
Cambia la columna E en "BD", ahora se registra un sólo artículo.
En la hoja "COMPRAS" celda I8, dice que ingresan 5 artículos, entonces, registra cinco filas con la misma información y en la columna E sólo registra 1.
Te anexo la macro actualizada
Sub Copiar_De_Compras_A_BD()
' Por Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("COMPRAS") 'Origen
Set h2 = Sheets("BD") 'Destino
cant = h1.Range("I8").Value
If cant = "" Or cant = 0 Or Not IsNumeric(cant) Then
MsgBox "Ingresa un valor numérico en cantidad"
Exit Sub
End If
'
For i = 1 To cant
h2.Rows("9:9").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
h2.Range("A9").Value = h1.Range("D4")
h2.Range("B9").Value = h1.Range("D6")
h2.Range("C9").Value = h1.Range("I6")
h2.Range("D9").Value = h1.Range("D8")
h2.Range("E9").Value = 1
h2.Range("F9").Value = h1.Range("D12")
h2.Range("G9").Value = h1.Range("D14")
h2.Range("H9").Value = h1.Range("I12")
h2.Range("J9").Value = h1.Range("I14")
h2.Range("I9").Value = h1.Range("D16")
h2.Range("L9").Value = h1.Range("I16")
h2.Range("K9").Value = h1.Range("D18")
h2.Range("M9").Value = h1.Range("D20")
Next
Application.ScreenUpdating = True
MsgBox "Registros copiados : " & cant
End Sub[sal u dos
