Macro para copiar fórmula hasta ultima celda con datos
tengo un código en VBA para que me copie unas formulas desde j1:w1 y que las pegue a partir de j19:w19 pero los datos que suelo usar varían desde 5000 hasta 15000 he intentado adaptar unos códigos pero solo me pega la formula hasta j19:w19 y me da un error 1004 en tiempo de ejecución Error en el metodo "Range" de objeto "_Global" anexo copia del archivo https://drive.google.com/open?id=1wtdGXJWw1P9AuShACz6-td3kVoenAEEY y del codigo que estoy usando
Sub Coberturar()
'
' Coberturar Macro
' Pasa las formulas al campo delimitado
'
'
Range("J1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveWindow.SmallScroll Down:=9
Range("J19").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=2
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("j19:w" & Range("J19:W").End(xlDown).Address).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=2
Application.CutCopyMode = False
Range("j19:" & Range("j19").End(xlDown).Address).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.SmallScroll ToRight:=-4
Range("C18").Select
Application.CutCopyMode = False
End Sub
3 respuestas
Ricardo Gonzalez,
Se paso a revisar el código y se identifico el error en la siguiente línea:
Selection.AutoFill Destination:=Range("j19:w" & Range("J19:W").End(xlDown).Address).Select
El código de negrita es el error, ahí dbería ir el número de la última fila de tu tabla y no debería estar ".Select".
Se adjunta el código corregido y depurado con los apostrofes (').
Sub Coberturar()
Dim N As Long
'
' Coberturar Macro
' Pasa las formulas al campo delimitado
'
N = Range(Range("c19"), Range("c19").End(xlDown)).Count + 18
Range("J1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'ActiveWindow.SmallScroll Down:=9
Range("J19").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'ActiveWindow.SmallScroll ToRight:=2
'Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("j19:w" & N), Type:=xlFillDefault
'Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'ActiveWindow.SmallScroll ToRight:=2
'Application.CutCopyMode = False
Range("j19:W" & N).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'ActiveWindow.SmallScroll ToRight:=-4
Range("C18").Select
'Application.CutCopyMode = False
End SubSin otro particular.
Todo tu código se puede reducir a uno más sencillo como el que esta después de la imagen, de hecho como comentario la instrucción replace no me funciona en campos formulados así que modifique tu fórmula inicial, la puse después de la macro.
Sub copiar_formulas()
Set formulas = Range("j1:w1")
Set destino = Range("c19").CurrentRegion
With destino
f = .Rows.Count: c = .Columns.Count
Set destino = .Cells(2, 8).Resize(f - 1, c - 12)
formulas.Copy: .PasteSpecial Paste:=xlPasteFormulas
End With
End Sub=SI(SI.ERROR(BUSCARV($D24,Venta_PZ,COINCIDIR(K$16,Tablas!$C$4:$X$4,0),0),0)=0,"",SI.ERROR(BUSCARV($D24,Venta_PZ,COINCIDIR(K$16,Tablas!$C$4:$X$4,0),0),0))
