VBA - 简化的复制和粘贴宏

Question

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

'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 

代码的其他部分可以以同样的方式降低，给它一试。
总是尽量避免使用.Select或Selection.，这是不好的做法。

请注意，我用Worksheets代替Sheets因为Worksheets对象仅包含的工作表，但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