-1

I am new to macros please help me below code not copy pasting all records from sheet one to another sheet. Only one row it is copying rest not copying please correct me where my code went wrong.

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

enter image description here

VBasic2008
  • 44,888
  • 5
  • 17
  • 28

3 Answers3

0

The comment above is correct when saying it's best to avoid using SELECT when copying/pasting data and he provided you with a great link.

Anyway, you have already written your code with SELECT so I'll just add on to your code to make it work.

The problem you were facing is you would copy the 2nd row (for i =2 <-- this is 2nd row), select Sheet3 as "active sheet", paste it but then you would never specify that we needed to make Sheet1 the "active sheet" to copy the next row.

Here's updated code to copy all rows from Sheet1 to 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
kooshy
  • 134
  • 1
  • 7
0

Copying columns of cells based on two column criteria can easily be accomplished with 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
0

Conditional Copy to Other Worksheet

  • Every .Range and .Cells refers to the sheet in the With statement which is in this case "Sheet1".
  • Save the worksheet after the loop has finished.
  • Try not to use Select and Activate, because they slow things down.
  • You don't have to use Offset in the calculation of erow, just add 1 to the row.
  • The Parent property is used to address the 'parent' of the object in the with statement which is "Sheet1". You could say that Parent means one level above which is the Workbook. So in this case it means ThisWorkbook or often it means Workbooks("asdfasdfasdfsafds.xls"). It is used when you're not interested in the Workbook, or you don't know the name etc.

The Code

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
VBasic2008
  • 44,888
  • 5
  • 17
  • 28