Copying data from Sheet1 to Sheet2, but in different order - Destination Row getting overwritten

[Khayyam]

Good Day,

I am trying to copy data from Sheet1 (which meets the conditions of an IF statement) and then paste the relevant cells for said row into Sheet2 of the same workbook.

Initially I managed to use the following code to simply pull in the relevant rows:

Sub Copy_to_Sheet2()
    
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If (Worksheets("Sheet1").Cells(i, 22).Value <> "Y" And Worksheets("Sheet1").Cells(i, 19).Value = "Yes") Then
Worksheets("Sheet1").Rows(i).Copy
    Worksheets("Sheet2").Activate
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Cells(b + 1, 1).Select
    Worksheets("Sheet2").Cells(b + 1, 1).PasteSpecial xlPasteValues
Worksheets("Sheet1").Cells(i, 22).Value = "Y"
End If

Next
    
    Application.CutCopyMode = False

End Sub

I then changed the code to try to copy specific cells to new columns in the destination worksheet:

Sub Copy_Arrivals_to_SiteVisits()
    
Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Set sht1 = Sheets("Sheet1")
    Set sht2 = Sheets("Sheet2")
        
    a = sht1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To a
    b = sht2.Cells(Rows.Count, 1).End(xlUp).Row
    For i2 = 6 To b
    
    
    If (sht1.Cells(i, 22).Value <> "Y" And sht1.Cells(i, 19).Value = "Yes") Then
        
        sht2.Cells(i2, 7) = sht1.Cells(i, 3)
        sht2.Cells(i2, 8) = sht1.Cells(i, 5)
        sht2.Cells(i2, 9) = sht1.Cells(i, 4)
        sht2.Cells(i2, 10) = sht1.Cells(i, 13)
        sht2.Cells(i2, 14) = sht1.Cells(i, 7)
         
        sht1.Cells(i, 22).Value = "Y"
    Else
    
    End If


Next i2
Next i


Application.CutCopyMode = False

End Sub

The problem with the second code is that it simply overwrites the same line over and over - I need it to write to a new line.

The solution may be simple, but I am somewhat of a novice and I have exhausted all my abilities in trying to crack this enigma.

Any help would be greatly appreciated.

Kind Regards,

Khayyam

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub Copy_Arrivals_to_SiteVisits()
   Dim sht1 As Worksheet
   Dim sht2 As Worksheet
   Set sht1 = Sheets("Sheet1")
   Set sht2 = Sheets("Sheet2")
   
   a = sht1.Cells(Rows.Count, 1).End(xlUp).Row
   b = sht2.Cells(Rows.Count, 1).End(xlUp).Row
   For i = 2 To a
      If (sht1.Cells(i, 22).Value <> "Y" And sht1.Cells(i, 19).Value = "Yes") Then
         sht2.Cells(b, 7) = sht1.Cells(i, 3)
         sht2.Cells(b, 8) = sht1.Cells(i, 5)
         sht2.Cells(b, 9) = sht1.Cells(i, 4)
         sht2.Cells(b, 10) = sht1.Cells(i, 13)
         sht2.Cells(b, 14) = sht1.Cells(i, 7)
         
         sht1.Cells(i, 22).Value = "Y"
         b = b + 1
      End If
   Next i
   Application.CutCopyMode = False
End Sub

 

[Khayyam]

Hi Fluff,

Thank you for your swift response. Your solution works to some extent (as in the rows are now being written below one another), however the last row gets overwritten with new data.

When I run the macro for the first time, it overwrites the header and then subsequent runs will overwrite the last row of data on the destination sheet.

Any solutions?

Many thanks,

Khayyam

 

[Fluff]

Ok, make this change

b = sht2.Cells(Rows.Count, 1).End(xlUp)[COLOR=#ff0000].Offset(1)[/COLOR].Row

 

[Khayyam]

Again Fluff, thank you immensely for your instant response time and profound knowledge.

The macro is now working a treat!

Have a great day!

 

[Fluff]

Glad to help & Thanks for the feedback