Excel VBA：将单元格从多个工作表复制到一张工作表

Question

我是VBA的新手，我试图在需要从6张工作表中提取选定单元格并将其合并到另一个工作表中的过程中自动执行一个过程。代码我有作品，但有点“笨重” - 我使用Excel的复制和粘贴功能，但似乎无法找到一个好的解决方案远离复制和粘贴功能。当我尝试添加一个粘贴特殊功能时，出现1004错误。爱建议优化这个！

对于要复制的每个工作表，单元格在第一列中用“1”，“0”或空白标记 - 如果单元格为“1”或“0”，我复制行中的其他单元格到合并表。行之间有一些空白，所以我选择使用For-Loop而不是Do-While语句。

我已经把它贴的代码如下：

Sub TEST() 
    Dim i As Integer 'copying row counter for each sheet to be copied 
    Dim j As Integer 'pasting row counter in consolidated sheet 
    Dim cal(1 To 6) As String 'copied sheetname 
      cal(1) = "Picks" 
      cal(2) = "Eats" 
      cal(3) = "Night Out" 
      cal(4) = "Active" 
      cal(5) = "Family" 
      cal(6) = "Arts" 
    Dim x As Integer 

    Dim y As Integer 'column for date 
    Dim z As Integer 'max row to run till 

    y = 1 'column checked in each sheet where condition for copying is met 
    z = 300 'number of rows to check in each sheet 

    j = 1 

    For x = 1 To 6 

    For i = 1 To z 
     If Sheets(cal(x)).Cells(i, y) = "0" Or Sheets(cal(x)).Cells(i, y) = "1" Then 
      Sheets(cal(x)).Select 
      Range(Sheets(cal(x)).Cells(i, 2), Sheets(cal(x)).Cells(i, 10)).Select 
      Selection.Copy 
      Application.Goto ActiveWorkbook.Sheets(Consolidated).Cells(j, 1) 
      ActiveSheet.Paste 
    Else 
     j = j - 1 
     End If 
     j = j + 1 
    Next i 
    Next x 
End Sub 

我又很想优化这段代码，使用另一种方法，而不是复制和粘贴的。我也尝试过：

Application.Goto ActiveWorkbook.Sheets(Consolidated).Cells(j, 1) 
ActiveSheet.PasteSpecial Operation:=xlPasteValues 

这导致了1004错误。想知道哪里出了问题。

Answer 1

由于您试图粘贴到活动页面而不是活动页面的范围中，并且您的方法的参数错误，因此您会收到错误消息。

这将工作，虽然这不是你想要做什么：（见CopyWithoutClipboard下文进一步一个更好的选择）

Sub PasteIntoGoto() 
    Sheets("sheet1").Range("A1").Copy 
    Application.Goto ActiveWorkbook.Sheets("Sheet3").Cells(1, 1) 
    ActiveSheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValues 
End Sub 

注意插入ActiveSheet和PasteSpecial和Paste:=Operation:=之间，而不是范围。

你是对的想要优化你的代码。也许Excel VBA开发中最重要的指导原则是千万不要选择任何东西，这会导致各种问题。在你的第一个例子中，你明确地使用了.Select，在第二个例子中，.GoTo实际上是在做同样的事情。

而不是选择的片材，复制范围，选择另一片，并粘贴到另一个范围时，就可以写入数据的一个拷贝到目标范围（无论是在相同的片上或另一个）是这样的：

Sub CopyWithoutClipboard() 
    Sheets("sheet1").Range("A1").Copy Sheets("sheet2").Range("A1") 
End Sub 

很明显，您可以使用变量来代替上面代码片段中的硬编码对象。