Macro pegar valores de un ciclo sin modificar formato

Para Dante Amor.
Hola Dante, antes que todo muchas gracias por tu ayuda.
Necesito que los datos de la Hoja2 se peguen como valores en la Hoja1, de tal modo de no modificar el formato ni las fórmulas de la Hoja1.
Destaco en color verde las celdas donde se deben pegar los datos (desde Hoja2 hacia Hoja1), de acuerdo al ciclo, estas son las celdas que tienen modificaciones, las demás celdas de la Hoja1 no sufren ningún cambio.
Agrego la macro que creaste inicialmente.
Por favor cualquier duda me avisas.
Muchas gracias.

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

Hoja2

Hoja1

Respuesta
2

La macro no copia celdas, solamente pone el valor, antes quitaba el formato porque limpiaba las celdas, pero ya comenté la instrucción que limpiaba las celdas. Revisa y me comentas. Todavía no me dices cómo llenar la columna A de la hoja1, es decir, de qué parte de la hoja2 tomo el dato para ponerlo en la hoja1

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("W").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 Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

¡Gracias Dante!! no es necesario llenar la columna A, la idea es dejar sus datos originales o iniciales, es así que eliminé la siguiente instrucción:

h1.Range("A" & j + 2 & ":A" & j + 39) = "www"

El único detalle (pero poco relevante) es que la siguiente instrucción: 

h1.Range("D" & j + 2 & ":D" & j + 39) = h2.Cells(i, "C")

Pone el valor en cada celda de la columna D, y el valor solo debe ir en D2, D43, D84, y así. Pero eliminando esa instrucción se soluciona todo.

Perdona mi falta de claridad para expresar lo que se necesitaba, estoy seguro que si hubiera sido más claro, te habría dado menos problemas.

Muchas pero muchas gracias nuevamente!!!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas