将具有多个非相邻单元格的区域复制到同一单元格上的另一张纸上

Question

I wrote the code below which works fine except that it takes forever and looks as if Excel is having an epileptic seizure.

Any help with something less prehistoric would be much appreciated.

Sub Data()
Sheets("2").Unprotect "Joe"
Worksheets("3").Range("a").Copy
Worksheets("2").Range("D10").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("b").Copy
Worksheets("2").Range("L10").PasteSpecial Paste:=xlPasteValues
Worksheets("2").Range("L18").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("c").Copy
Worksheets("2").Range("D11").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("d").Copy
Worksheets("2").Range("L11").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("e").Copy
Worksheets("2").Range("D17").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("f").Copy
Worksheets("2").Range("L17").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("g").Copy
Worksheets("2").Range("D18").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("h").Copy
Worksheets("2").Range("D19").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("i").Copy
Worksheets("2").Range("L19").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("j").Copy
Worksheets("2").Range("D20").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("k").Copy
Worksheets("2").Range("E22").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("l").Copy
Worksheets("2").Range("E23").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("m").Copy
Worksheets("2").Range("E24").PasteSpecial Paste:=xlPasteValues
End Sub

Answer 1

Sub Data()

Dim rng As Range

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


Sheets("2").Unprotect "Joe"

With Worksheets("2")
    Set rng = Range("a")
    .Range("D10").Resize(rng.Rows.Count, rng.Columns.Count).Value2 = rng.Value2

    Set rng = Range("b")
    .Range("L10").Resize(rng.Rows.Count, rng.Columns.Count).Value2 = rng.Value2

'...and so on

End With


With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Note that because you're using range names for a, b, c then there is no need to qualify them with a sheetname unless they are locally scoped.

Answer 2

Instead of copy-pasting, you could also set the value of your destination cell equal to the value of your original cell. For example:

Worksheets("2").Range("D10").Value = Worksheets("3").Range("a").Value

To prevent the seizure like behavior in the application window of Excel, do as Excelosaurus suggested and turn off screen updating at the start of your macro. (And make sure to turn it back on at the end).

Answer 3

在子Application.ScreenUpdating = False的开头放置Application.ScreenUpdating = False ，在结尾放置Application.ScreenUpdating = True 。