I'm trying to write a code (see below) which takes formulas from the selected range and pastes them in another range defined by the user without changing the reference.
I'm having trouble with writing the items from the array to the worksheet. It just pastes the first item... I've read some posts and applied various codes but none of these worked... Can you give some advice how to fix that? Thanks in advance.
Sub copy_formulas()
Dim formula As String
Dim rg As Range, rg_row As Integer, rg_column As Integer
Dim cl As Range
Dim col As New Collection, i As Integer
Dim arr As Variant
Dim output As Range
Set rg = Selection
rg_row = rg.Rows.Count
rg_column = rg.Columns.Count
For Each cl In rg
If cl.Value = "" Then
formula = ""
Else
formula = cl.FormulaLocal
End If
col.Add formula
Next
ReDim arr(1 To col.Count)
For i = 1 To col.Count
arr(i) = col.Item(i)
Next i
Set output = Application.InputBox("Select Range", "Range for pasting formulas", Type:=8)
output.Resize(rg_row, rg_column).Select
output.FormulaLocal = arr
End Sub
EDIT :
For anyone who is interested, this is what I finally came up with:
Sub copy_formulas()
Dim formula As String
Dim rg As Range, rg_row As Integer, rg_column As Integer
Dim cl As Range
Dim col As New Collection, i As Integer, y As Integer
Dim arr() As Variant
Dim output As Range
Set rg = Selection
rg_row = rg.Rows.Count
rg_column = rg.Columns.Count
For Each cl In rg
If cl.Value = "" Then
formula = ""
Else
formula = cl.FormulaLocal
End If
col.Add formula
Next
ReDim arr(1 To rg_row, 1 To rg_column)
For i = 1 To rg_row
For y = 1 To rg_column
arr(i, y) = col.Item(((i - 1) * rg_column) + y)
Next y
Next i
Set output = Application.InputBox("Select Range", "Range for pasting formulas", Type:=8)
output.Resize(rg_row, rg_column).FormulaLocal = arr
End Sub
I would appreciate any feedback on this topic.
OK, so this task can be solved in an easier way (below). Although, I would be interrested how it can be done using the code mentioned in the first question...
Sub copy_formulas_2()
Dim y As Variant
Dim rg_row As Integer, rg_column As Integer
Dim i As Long
With Selection
y = .FormulaLocal
rg_row = .Rows.Count
rg_column = .Columns.Count
End With
Set output = Application.InputBox("Select Range", "Range for pasting formulas", Type:=8)
output.Resize(rg_row, rg_column).FormulaLocal = y
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.