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

Khayyam

New Member
Joined
Nov 22, 2018
Messages
3
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:
Code:
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:
Code:
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
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,416
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel
How about
Code:
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
 
Last edited:

Khayyam

New Member
Joined
Nov 22, 2018
Messages
3
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,416
Office Version
  1. 365
Platform
  1. Windows
Ok, make this change
Code:
b = sht2.Cells(Rows.Count, 1).End(xlUp)[COLOR=#ff0000].Offset(1)[/COLOR].Row
 

Khayyam

New Member
Joined
Nov 22, 2018
Messages
3
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,416
Office Version
  1. 365
Platform
  1. Windows
Glad to help & Thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,109,131
Messages
5,527,020
Members
409,736
Latest member
maanbunty

This Week's Hot Topics

Top