Macro que Copie, busque la ultima fila vacia y desde ahi pegue las formulas hasta la fila 1000
Estoy tratando de corregir esta macro, lo que quiero es que me copie la informacion de la fila F1 hasta la Columna H1; despues se posicione la ultima fila vacia de la columna F y desde ahi pegue las formulas hasta la fila F1000, hice esta macro pero... Solo llego a copiar y pegar en la siguiente fila vacia pero no logro pegar las formulas en mas filas
Sub Copiar()
Range("F1:H1").Select
Selection.Copy
Sheets("HOJA1").Select
Range("F8").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
2 respuestas
En mi último video explico algunos errores al copiar/pegar códigos.
En primer lugar no es necesario seleccionar... copiar---seleccionar... pegar. Se evitan muchas líneas de código.
Sub Copiar()
'ajustada x Elsamatilde
'copiar rango
Range("F1:H1").Copy
Sheets("HOJA1").Select
'atención.si f9 no tiene datos dará error
Range("F8").End(xlDown).Offset(1, 0).Select
'pega fórmulas
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Pero intenta ejecutarlo cuando en F9 no hay datos aún. Dará error.
Por eso, el código todavía puede ser mejorado del siguiente modo:
Sub Copiar()
'ajustada x Elsamatilde
'se declara la hoja destino y se busca su primer fila libre según col F
Set ho1 = Sheets("Hoja1")
'1er fila destino buscándola desde abajo
ini = ho1.Range("F" & Rows.Count).End(xlUp).Row + 1
'se copia el rango (sin seleccionar)
Range("F1:H1").Copy
'pega fórmulas
ho1.Range("F" & ini).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'arrastra las fórmulas de la fila ini hasta la 1000
ho1.Range("F" & ini & ":H" & ini).AutoFill Destination:=ho1.Range("F" & ini & ":H1000"), Type:=xlFillDefault
Application.CutCopyMode = False
End Sub
Usa esta macro es más corta
Sub Copia2()
Set h1 = Worksheets("hoja1")
Set h2 = Worksheets("hoja2")
h2.Range("h1:f1").Copy
With h1
.Select
With Range("f8")
r = .CurrentRegion.Rows.Count
c = .CurrentRegion.Columns.Count
If r = 1 And c = 1 Then .Resize(r + 999).PasteSpecial xlPasteFormulas
If r >= 1 And c > 1 Then .Rows(r + 1).Resize(r + 999).PasteSpecial xlPasteFormulas
End With
End With
End Sub