Macro pegar rango de valores para un ciclo
Necesito de su valiosa ayuda.
Necesito copiar una rango de datos desde la hoja2 hacia la hoja1.
Los datos presentes en la hoja2 están de manera horizontal y se deben pegar
En la hoja1 en un ciclo de 41 filas.
Sé que es algo complejo, pero sería de gran ayuda si me pueden orientar.
Muchas gracias!
Hoja2
Hoja1
Te anexo la macro
Sub Copiar_Valores()
'Por.Dante Amor
'
Set h1 = Sheets("Hoja1") 'destino
Set h2 = Sheets("Hoja2") 'datos
'
h1.Cells.Clear
'
j = 1
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A" & j & ":D" & j) = Array("Cod.Interno", "Prod.", "Descrip.", "Price $")
h1.Range("B" & j + 1) = h2.Cells(i, "A") 'prod
h1.Range("C" & j + 1) = h2.Cells(i, "B") 'desc
h1.Range("D" & j + 1) = h2.Cells(i, "C") 'price
col = Columns("E").Column
For k = Columns("D").Column To Columns("M").Column
If h2.Cells(i, k) <> "" Then
h1.Cells(j, col) = h2.Cells(1, k)
h1.Cells(j + 1, col) = h2.Cells(i, k)
col = col + 1
End If
Next
h1.Range("A" & j + 2 & ":A" & j + 42) = "www"
h1.Range("D" & j + 2 & ":D" & j + 42) = h2.Cells(i, "C")
h1.Range("A" & j + 43) = "SALDO"
'
With h1.Range(h1.Cells(j + 43, "E"), h1.Cells(j + 43, "N"))
.FormulaR1C1 = "=SUM(R[-42]C:R[-1]C)"
End With
j = j + 44
Next
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Muchas gracias Dante, pero tengo las siguientes dificultades:
- La palabra "www" es una variable, agrego uan foto donde se puede apreciar mejor.
- Al ejecutar la macro desaparece el formato original de la Hoja1 (viculado a otras fórmulas), por lo que es necesario solo pegar como valores.
Por favor tu ayuda!!!
Los valores deben pegarse en B2:D2, B43:D43, B84:D84, y asi consecutivamente.
Y según sea el caso desde E1:V1-E2:V2, E42:V42-E43:V43, y así consecutivamente.
Te regreso la macro con los cambios: No borrar el formato de la hoja1. Pegar en B2, B43, B84 ...
No entiendo a qué te refieres con :
"Y según sea el caso desde E1:V1-E2:V2, E42:V42-E43:V43, y así consecutivamente"
La macro copia tal cual pusiste el ejemplo:
Hoja1
Por último mencionas esto:
- La palabra "www" es una variable, agrego uan foto donde se puede apreciar mejor.
Pero no explicas de dónde se toma esa variable.
Hola Dante!! Me enviaste una respuesta pero no puedo verla en la página :(
Va nuevamente la macro
Sub Copiar_Valores()
'Por.Dante Amor
'
Set h1 = Sheets("Hoja1") 'destino
Set h2 = Sheets("Hoja2") 'datos
'
'h1.Cells.Clear
'
j = 1
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
'h1.Range("A" & j & ":D" & j) = Array("Cod.Interno", "Prod.", "Descrip.", "Price $")
h1.Range("B" & j + 1) = h2.Cells(i, "A") 'prod
h1.Range("C" & j + 1) = h2.Cells(i, "B") 'desc
h1.Range("D" & j + 1) = h2.Cells(i, "C") 'price
col = Columns("E").Column
For k = Columns("D").Column To Columns("M").Column
If h2.Cells(i, k) <> "" Then
h1.Cells(j, col) = h2.Cells(1, k)
h1.Cells(j + 1, col) = h2.Cells(i, k)
col = col + 1
End If
Next
h1.Range("A" & j + 2 & ":A" & j + 39) = "www"
h1.Range("D" & j + 2 & ":D" & j + 39) = h2.Cells(i, "C")
'h1.Range("A" & j + 40) = "SALDO"
'
'With h1.Range(h1.Cells(j + 41, "E"), h1.Cells(j + 41, "N"))
' .FormulaR1C1 = "=SUM(R[-42]C:R[-1]C)"
'End With
j = j + 41
Next
MsgBox "Fin"
End Subsal u dos
Funciona muy bien!!
Muchas gracias Dante!!!
Elimine lo siguiente para que no cambiar algunos datos de la columna A
h1.Range("A" & j + 2 & ":A" & j + 39) = "www"Y elimine lo siguiente
h1.Range("D" & j + 2 & ":D" & j + 39) = h2.Cells(i, "C")Para no eliminar algunas fórmulas que estaban el columna D.
Muchas, muchas gracias!!
