excel - How to take row from worksheet and paste onto another worksheet row by row

Question

I am new to vba/coding and I am not sure how to proceed from this point. I am currently trying to copy some columns of a row that matches three of my criteria and paste it on to another worksheet row by row so that it lists out. I know my logic is all over the place but if I could get some pointers it would be much appreciated.

Application.ScreenUpdating = False 

Dim Today, EndDate as Date

Dim MainWorksheet as worksheet

Today = Sheets("sheet1").Range("k8").Value
EndDate = Sheets("sheet1").Range("k9").Value

Set MainWorksheet = Worksheets("sheet2")

Dim Name as String

Name = "Condition 1"

a = MainWorksheet.Cells(Rows.Count, 1).End(xlUP).Row

For i = 2 to a

    Dim z as boolean
    Dim x as boolean
    Dim c as boolean

    z = Mainworksheet.Cells(i,7).Value >= Today
    x = Mainworksheet.Cells(i,8).Value <= EndDate
    c = Mainworksheet.Cells(i,6).Value = Name

If z And x And c = True Then
    
    MainWorksheet.Rows(i).Range("b1,f1,g1,h1,k1,d1").copy

    worksheets("sheet1").Activate

    Range("k8").Select

        If ActiveCell.Value = "" then

        Activecell.PasteSpecial

            Else

                ActiveCell.offset(1,0).select

                Activecell.PasteSpecial

            End if

       End if

 Next i


End sub

question from:https://stackoverflow.com/questions/65600659/how-to-take-row-from-worksheet-and-paste-onto-another-worksheet-row-by-row

Answer 1

Copy Specified Cells (Columns) of Rows

• Although it does the job, it does it slowly.
• Note that if there would be only values (no formulas, formats) needed to be copied, a different solution may increase the speed of execution dozens of times. And further more, implementing arrays may increase the speed of execution probably even hundreds of times.

The Code

Option Explicit

Sub copyReport()
    
    ' Constants
    Const Criteria As String = "Condition 1"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    
    ' Source Worksheet
    Dim src As Worksheet: Set src = wb.Worksheets("Sheet2")
    ' Last Row, the row of the last non-empty cell in column 'A'
    Dim srcLast As Long: srcLast = src.Cells(src.Rows.Count, "A").End(xlUp).Row
    ' Destination Worksheet
    Dim dst As Worksheet: Set dst = wb.Worksheets("Sheet1")
    ' Last Cell, the last non-empty cell in column 'K'
    Dim dCell As Range: Set dCell = dst.Cells(dst.Rows.Count, "K").End(xlUp)
    ' Dates: Start Date, End Date
    Dim sDate As Date: sDate = dst.Range("K8").Value
    Dim eDate As Date: eDate = dst.Range("K9").Value
    
    ' Declare variables.
    Dim rng As Range ' Current Source Range
    Dim sCell As Range ' Current Cell in Current Area of Current Source Range
    Dim i As Long ' Source Rows Counter
    Dim j As Long ' Destination Columns Counter
    Dim bCrit As Boolean ' Criteria Validator
    Dim bStart As Boolean ' Start Date Validator
    Dim bEnd As Boolean ' End Date Validator
    
    Application.ScreenUpdating = False
    
    ' Loop
    For i = 2 To srcLast
        
        bCrit = (src.Cells(i, "F").Value = Criteria)
        bStart = (src.Cells(i, "G").Value >= sDate)
        bEnd = (src.Cells(i, "H").Value <= eDate)
        
        If bCrit And bStart And bEnd Then
            Set rng = src.Rows(i).Range("B1,F1,G1,H1,K1,D1")
            Set dCell = dCell.Offset(1)
            ' You cannot use 'rng.Copy dCell' because it will copy
            ' "B1,D1,F1,G1,H1,K1".
            j = 0
            For Each sCell In rng.Areas
                sCell.Copy dCell.Offset(, j)
                j = j + 1
            Next sCell
        End If
    
    Next i

    Application.ScreenUpdating = False

End Sub