Excel 无法将数据从一个工作表填充到另一个工作表

我是新的宏请帮助我下面的代码不要复制粘贴所有记录从一个工作表到另一个工作表。 只有一行它正在复制其余的没有复制请纠正我的代码哪里出错了

Private Sub CopyData()
Dim LastRow As Integer, i As Integer, erow As Integer

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

'If Cells(i, 1) = Date And Cells(i, 2) = “Sales” Then
Range(Cells(i, 1), Cells(i, 4)).Select
Selection.Copy

Worksheets("Sheet3").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
'ActiveWorkbook.Close
Application.CutCopyMode = False
'End If

Next i
End Sub

---

上面的评论说复制/粘贴数据时最好避免使用

SELECT

，这是正确的，他为您提供了一个很好的链接

无论如何，您已经使用

SELECT

编写了代码，因此我将添加到您的代码中，使其正常工作

---

您面临的问题是，您将复制第二行（对于i=2），使用AutoFilter可以轻松完成基于两列标准复制单元格列的操作

Option Explicit

Private Sub CopyData()

    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False

        With .Cells(1, 1).CurrentRegion

            .AutoFilter field:=1, Criteria1:=Date
            .AutoFilter field:=2, Criteria1:="sales"

            With .Resize(.Rows.Count - 1, 4).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    .SpecialCells(xlCellTypeVisible).Copy _
                      Destination:=Worksheets("sheet3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                End If
            End With

        End With

        .AutoFilterMode = False
    End With

End Sub

有条件复制到其他工作表

• 每个.Range和.Cells都是指中带有 语句，在本例中为“Sheet1”
• 循环完成后保存工作表
• 尽量不要使用

  选择

  和

  激活

  ，因为它们会减慢速度 放下
• 在计算erow时不必使用偏移量，只需添加1即可 排成一排
• Parent属性用于寻址对象的“Parent” 在with语句中，它是“Sheet1”。您可以这样说 Parent表示工作簿的级别。因此，在本例中，它指的是本工作簿，或者通常指 工作簿（“asdfasdfasdfafds.xls”）。当您不在 对工作簿感兴趣，或者不知道名称等

代码

---

这将是解决问题的一个良好开端如果对您有帮助，请将其中一个答案标记为正确答案。如果目标工作表合并了行，请帮助我如何粘贴感谢您的帮助。但这不是粘贴到目标工作表列中的合并单元格。您必须问一个新问题

Option Explicit

Private Sub CopyData()

    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False

        With .Cells(1, 1).CurrentRegion

            .AutoFilter field:=1, Criteria1:=Date
            .AutoFilter field:=2, Criteria1:="sales"

            With .Resize(.Rows.Count - 1, 4).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    .SpecialCells(xlCellTypeVisible).Copy _
                      Destination:=Worksheets("sheet3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                End If
            End With

        End With

        .AutoFilterMode = False
    End With

End Sub

Sub CopyData()

  Const cVntSource As Variant = "Sheet1"  ' SourceWorksheet Name/Index
  Const cVntTarget As Variant = "Sheet3"  ' Target Worksheet Name/Index

  Dim wsSource As Worksheet               ' Source Worksheet
  Dim wsTarget As Worksheet               ' Target Worksheet
  Dim LastRow As Long                     ' Source Last Row
  Dim i As Integer                        ' Source Row Counter
  Dim erow As Integer                     ' Target Row Counter

  Set wsSource = Worksheets(cVntSource)
  Set wsTarget = Worksheets(cVntTarget)

  With wsSource

    LastRow = .Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRow

      If .Cells(i, 1) = Date And .Cells(i, 2) = "Sales" Then
        erow = wsTarget.Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range(.Cells(i, 1), .Cells(i, 4)).Copy wsTarget.Cells(erow, 1)
      End If

    Next

    .Parent.Save
'    .Parent.Close

  End With

End Sub