Невозможно заполнить данные с одного листа на другой лист

Question

Я новичок в макросах, пожалуйста, помогите мне ниже код не копировать, вставляя все записи с листа один на другой лист.Только одна строка копирует, остальные не копируют, пожалуйста, исправьте меня, где мой код ошибся.

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

Answer 1

Копирование столбцов ячеек на основе двух критериев столбцов можно легко выполнить с помощью автофильтра.

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

Answer 2

Условное копирование на другой рабочий лист

• Каждый .Range и .Cells относится к листу в операторе С , которыйв этом случае " Sheet1 ".
• Сохранить рабочий лист после цикл завершен.
• Старайтесь не использовать Select и Activate, потому что они замедляют работу.
• Вам не нужно использовать смещение при расчете erow, просто добавьте 1 к строке.
• Parent свойство используется для обращения к «родительскому объекту» объекта в операторе with, который равен « Sheet1 ».Можно сказать, что Parent означает один уровень выше, который является Рабочей книгой.Таким образом, в этом случае это означает ThisWorkbook или часто это означает Workbooks («asdfasdfasdfsafds.xls»).Он используется, когда вас не интересует Рабочая тетрадь, или вы не знаете названия и т. Д.

Код

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

Answer 3

Приведенный выше комментарий верен, когда говорится, что лучше избегать использования SELECT при копировании / вставке данных, и он предоставил вам отличную ссылку.

В любом случае, вы уже написали свой код с SELECTпоэтому я просто добавлю ваш код, чтобы он заработал.

Проблема, с которой вы столкнулись, заключается в том, что вы скопируете 2-ю строку (для i = 2 <- это 2-я строка), выберите Sheet3 в качестве «активного листа», вставьте его, но тогда вы никогда не укажете, что мынеобходимо сделать Sheet1 «активным листом» для копирования следующей строки.</p>

Вот обновленный код для копирования всех строк из Sheet1 в Sheet3

Private Sub CopyData()
Dim LastRow As Integer, i As Integer, erow As Integer
Worksheets("Sheet1").Select 'Set Active sheet to "Sheet1" 
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'Get last row

For i = 1 To LastRow 'start loop, with row 1 as first row to copy. Adjust as needed
    Range(Cells(i, 1), Cells(i, 4)).Select 'select that row
    Selection.Copy 'copy the row

    Worksheets("Sheet3").Select 'now select the sheet where you want to paste it
    ActiveSheet.Cells(i, 1).Select 'we can use i variable, this will paste it in the same row number as it were in Sheet1
    ActiveSheet.Paste 
    Application.CutCopyMode = False
    Worksheets("Sheet1").Select 'now Select Sheet1 again so you can copy the next row

Next i
End Sub