VBA – 简化的复制和粘贴macros

我在简化将各种数据复制并粘贴到各种表格中的macros时遇到困难。

'Put the date and time across the top Dim rngDT As Range Set rngDT = Worksheets("Data").Range("A2:B2") Worksheets("Data").Range(rngDT, rngDT.End(xlDown)).Copy Worksheets("Reporting").Range("C5").Offset((x - 1) * 12, 0).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 'Copy and transpose the names from the names page Worksheets("Point Names").Range("B1:B3").Offset(x, 0).Copy _ (Worksheets("Reporting").Range("B7").Offset((x - 1) * 12, 0)) 'Copy and transpose the data Dim dataRng As Range Set dataRng = Worksheets("Data").Range("C1:E1").Offset(1, 3 * x - 3) '.Range("A1:C1") Worksheets("Data").Range(dataRng, dataRng.End(xlDown)).Copy Worksheets("Reporting").Range("C7").Offset((x - 1) * 12, 0).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 'Sheets("Data").Select 'Range("A1").Select 'ActiveCell.Offset(1, x + 1).Range("A1:C1").Select 'Range(Selection, Selection.End(xlDown)).Select 'Selection.Copy 'Sheets("Reporting").Select 'Range("C7").Offset((x - 1) * 12, 0).Select 'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True 

另外作为参考，它在这个例子中循环For x = 1 To NumPoints NumPoints = 33 。 预先感谢您，任何帮助将不胜感激

Answer 1

第一个代码块可以缩小到如下所示：

 'Put the date and time across the top Dim rngStart As Range Set rngStart = Worksheets("Data").Range("A2:B2") Worksheets("Data").Range(rngStart, rngStart.End(xlDown)).Copy Worksheets("Reporting").Range("C5").Offset((x - 1) * 12, 0).PasteSpecial Paste:=xlPasteAll, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=True 

其余的代码可以用相同的方法减less，试一试。
总是尽量避免使用Selection.或Selection. 这是不好的做法。

请注意，我使用Worksheets而不是Sheets因为Worksheets对象只包含工作表，但Sheets对象也包含工作表和图表等。 除非您确实需要Sheets ，否则我build议您始终使用Sheets Worksheets Sheets除非大多数情况下您不需要Sheets 。

---

还要确保每个 Range ， Columns ， Rows ， Cells等都以一个有效的命名工作表作为前缀。 如果不是VBA，则假定你的意思是ActiveSheet 。 这意味着：

 Range(rngStart, rngStart.End(xlDown)).Copy 

是完全一样的

 ActiveSheet.Range(rngStart, rngStart.End(xlDown)).Copy 

但ActiveSheet不是一个定义的工作表。 因此，积极的表可能是正确的，但也有可能不是。 所以你得到一个随机工作/不工作的代码。

因此，总是使用一个定义的工作表

 Worksheets("Data").Range(rngStart, rngStart.End(xlDown)).Copy 

并决不让VBA承担工作表。

---

编辑您的评论。 这将是这样的：

 Dim dataRng As Range Set dataRng = Worksheets("Data").Range("A1").Offset(1, x + 1).Range("A1:C1") Worksheets("Data").Range(dataRng, dataRng.End(xlDown)).Copy Worksheets("Reporting").Range("C7").Offset((x - 1) * 12, 0).PasteSpecial Paste:=xlPasteAll, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=True