Copiar filas de una hoja agregando 2 filas extra entre cada una
Me gustaría si se puede hacer una macro que haga esto:
Tengo datos en la hoja Summary y quiero copiar todas las filas desde la fila 3, agregando 2 filas nuevas entre cada fila copiada y que en la primer fila a partir de la columna E haga una resta por ejemplo:
La fila 4 tiene la primera fila copiada de la hoja Summary entonces se agregan 2 filas, en la primera (5) a partir de la columna E empezaría una resta E5 seria E4-D4, en F5 =F4-E4, en la siguiente fila agregada (6) de igual forma a partir de la columna E empezaría E6 =1-(D4/E4) después en F6==1-(E4/F4)
Después se copiar la siguiente fila agregar las 2 filas extra y poner las fórmulas
Prueba con esta macro
Sub copiar_datos()
Dim ho As Worksheet, hd As Worksheet
Set ho = Worksheets("summary")
Set hd = Worksheets("hoja2")
hd.Cells.Clear
ho.Range("a3").CurrentRegion.Copy
hd.Range("a2").PasteSpecial xlPasteValues
Sheets("hoja2").Select
Set DATOS = Range("a2").CurrentRegion
With DATOS
F = .Rows.Count: c = .Columns.Count
Set DATOS = .Rows(2).Resize(F - 1, c)
.Cells(1, 4).Resize(F - 1, c - 3).NumberFormat = "$0,0.00"
X = 2
For I = 1 To F
If I > 1 Then
.Rows(X).Resize(2).EntireRow.Insert
X = X + 3
End If
Next I
NF = (F * 3) - 3
Set DATOS = .Resize(NF, c)
.Select
For j = 1 To NF Step 3
.Cells(j + 1, 5).Resize(1, c - 4).Formula = "=" & .Cells(1, 5).Address(False, False) & "-" & .Cells(1, 4).Address(False, False)
.Cells(j + 2, 5).Resize(1, c - 4).Formula = "=" & .Cells(j + 1, 5).Address(False, False) & "/" & .Cells(j, 5).Address(False, False)
.Cells(j + 2, 5).Resize(1, c - 4).NumberFormat = "0.00%"
Next j
End With
End Sub
Hola, agradezco la respuesta, solo que tengo un problema, la resta se quedo estática a la primera fila, es decir, para los datos de E588 en lugar de en la celda de abajo E599 restar =E588-D588 sigue restando E3-D3, y la división en lugar de ser E4/E3 debería de ser D3/E3, estoy intentando modificar el código para ver si puedo dar con los ajustes necesarios, y me disculpo soy primerizo en esto de las macros
Ya cheque la macro y le hice algunas modificaciones.
Sub copiar_datos()
Dim ho As Worksheet, hd As Worksheet
Set ho = Worksheets("summary")
Set hd = Worksheets("hoja2")
hd.Cells.Clear
ho.Range("a3").CurrentRegion.Copy
hd.Range("a2").PasteSpecial xlPasteValues
Sheets("hoja2").Select
Set DATOS = Range("a2").CurrentRegion
With DATOS
F = .Rows.Count: c = .Columns.Count
Set DATOS = .Rows(2).Resize(F - 1, c)
.Cells(1, 4).Resize(F - 1, c - 3).NumberFormat = "$0,0.00"
X = 2
For I = 1 To F
If I > 1 Then
.Rows(X).Resize(2).EntireRow.Insert
X = X + 3
End If
Next I
NF = (F * 3) - 3
Set DATOS = .Resize(NF, c)
.Select
For J = 1 To NF Step 3
.Cells(J + 1, 4).Resize(1, c - 3).Formula = "=" & .Cells(J, 4).Address(False, False) & "-" & .Cells(J, 3).Address(False, False)
.Cells(J + 2, 4).Resize(1, c - 3).Formula = "=" & .Cells(J + 1, 4).Address(False, False) & "/" & .Cells(J, 4).Address(False, False)
.Cells(J + 2, 4).Resize(1, c - 3).NumberFormat = "0.00%"
Next J
End With
End Sub
