加快跨多个工作表的复制/粘贴 VBA

Question

I have managed to write code which runs but it's quite slow (takes about 2 minutes atm and the block size is going to increase by 52 soon). I would like to know if there's a better way to achieve this small section of code. The code selects 10 sheets simultaneously so that the copy and paste will affect all 10 sheets. The only copy and paste that I could get to work was the absolute worst version, as you can see, because all the other options I tried only pasted the ranges to a single sheet, not all 10. Would love to know if it's possible to do better. I had to activate the first sheet and do the full range.copy, range.select, activesheet.paste, varray contains 10 sheet names, MaxRngLive is 20. RngLiveRange is a 1 dimensional array of 156 columns containing live formulae and RngPasteRange is a 156x156 block into which those formulae will be pasted, Later in the code. I value out all of the cells in each block except the top row (again using range,pastespecial xlpastevalues.), thus reducing file size by about 75% overall.

Sheets(varray).Select

Sheets("c_DAZN.com_GF").Activate

Set ws2 = wb.Worksheets(varray(0))


For j = 1 To MaxRngLive
      
    Application.StatusBar = ws2.Name & " " & j
      
    Set RngLiveRange = ws2.Range(Range(RngLiveName).Rows(j))
    Set RngPasteRange = ws2.Range(Range(RngPasteName).Rows(j))
    RngLiveRange.Copy
    RngPasteRange.Select
    ActiveSheet.Paste
    
Next j

Thanks very much everyone!

Answer 1

This should do what you want. I'm assuming your list of destination sheets is a string

Function copyRange(sourceRange As Variant, destRange As String, wks as String)
    arr = Split(wks, ",")
    For Each i In arr
        Worksheets(i).Range(destRange) = sourceRange.Formula
    Next i
End Function

Sub test()
wk = "Sheet1,Sheet2,Sheet3" 'Comma separated list of destination sheets
'Tested by selecting the range to be copied, you can define your source range however you want
Call copyRange(Selection, Selection.Address, wk)
End Sub