简体   繁体   中英

Excel VBA - Writing array to the Worksheet

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM