将具有多个不相邻单元格的区域复制到同一单元格上的另一个工作表

我写了下面的代码工作正常，除了它需要永远，看起来像Excel是癫痫发作。

任何帮助史前史的东西将不胜感激。

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 

请注意，因为您使用a，b，c的范围名称，所以不需要使用sheetname限定它们，除非它们在本地范围内。

Answer 2

您也可以将目标单元格的值设置为等于原始单元格的值，而不是复制粘贴。 例如：

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

为了防止在Excel的应用程序窗口中出现类似的行为，请按照Excelosaurus的build议，在macros的开始处closures屏幕更新。 （并确保在最后打开它）。

Answer 3

把Application.ScreenUpdating = False放在你的子开始处，并且在最后加上Application.ScreenUpdating = True 。