Macro to copy cells under condition

[alicjon]

Hi guys,

I need help with macro
I need macro, that will be copy value from cells in column B from sheet1 to first avaible (free) cell in column D of sheet2 under condition that in cell in column F of sheet1 (in that row) is value "yes". After that i need to remove that row in sheet1. I have something like this at this moment:

Sub ddd() 


    Dim OstW As Long 
    Dim kom As Excel.Range 

    Application.ScreenUpdating = False 

    With Sheets("Sheet1") 
        OstW = .Cells(Rows.Count, "F").End(xlUp).Row 

        For Each kom In .Range("F4:F" & OstW) 
            If kom.Value = "yes" Then 
                Range("B4:B").Copy 
                
                With Sheets("Sheet2") 
                    Range("D5:D").PasteSpecial 
                    Paste = xlPasteValues 
                    
                End With 
                
                .Rows(kom.Row).Delete 
            End If 
        Next kom 

    End With 

    Application.ScreenUpdating = True 

End Sub

I hope you can help me.
Please!

 

[JLGWhiz]

I didn't know what the 'Range("B4, B") and Range("D5, D") meant so I improvised.

Sub ddd()
    Dim OstW As Long 
    Dim kom As Excel.Range
    Application.ScreenUpdating = False
    With Sheets("Sheet1") 
        OstW = .Cells(Rows.Count, "F").End(xlUp).Row
        For Each kom In .Range("F4:F" & OstW) 
            If kom.Value = "yes" Then 
                kom.Offset(0, -4).Copy 
                With Sheets("Sheet2") 
                    .Cells(Rows.Count, "D").End(xlUp)(2).PasteSpecial xlPasteValues 
                End With 
                .Rows(kom.Row).Delete 
            End If 
        Next kom 
    End With 
    Application.ScreenUpdating = True 
End Sub

 

[alicjon]

It is very close to that what i need (THANK YOU!) but when i start macro only the cell from last row of sheet1 being copied (and deleta after that). I must start macro again for another row, and one more time, and so on. Can you tell what should be diffrent in the code, that every rows in sheet1 will be analysed?

 

[My Aswer Is This]

Try this:

Sub Copy_Delete_Row()
Dim i
Dim Lastrow
Dim LastrowTwo
Dim aa
Dim a
Dim My
a = 0
Lastrow = Range("B1").End(xlDown).Row
LastrowTwo = Worksheets("Sheet2").Range("A1").End(xlDown).Row
For i = 1 To Lastrow
My = Sheets("Sheet2").Range("D1").End(xlDown).Row + 1
aa = Trim(Cells(i, 6).Value)
If aa = "Yes" Then
a = a + 1
Sheets("Sheet2").Cells(My, 4) = Cells(i, 2).Value
Rows(i).Delete
End If
Next
End Sub

 

[VoG]

Cross posted Macro which copy cells if other cell have specific value

Please read Excelguru Help Site - A message to forum cross posters

 

[VoG]

And here Macro which copy cells if other cell have specific value

 

[My Aswer Is This]

If he cross posted I did not know that. I learned a few things creating this script for him. Well another day.

 

[JLGWhiz]

Should have looked closer. When deleting rows, it is more efficient to work from the bottom of the file upward so that rows are not skipped due to the automatic shifting upon deltion. This should get all rows on the first pass.

Sub ddd()
    Dim OstW As Long 
    Application.ScreenUpdating = False
    With Sheets("Sheet1") 
        OstW = .Cells(Rows.Count, "F").End(xlUp).Row
        For i = lr To 5 Step -1
            If .Cells(i, 6).Value = "yes" Then 
                .Cells(i, 2).Copy 
                With Sheets("Sheet2") 
                    .Cells(Rows.Count, "D").End(xlUp)(2).PasteSpecial xlPasteValues 
                End With 
                .Rows(i).Delete 
            End If 
        Next
    End With 
    Application.ScreenUpdating = True 
End Sub

The purpose in notifying responders that you have cross posted is so that we will not spend a lot of time trying to develop a solution if someone from another site has resolved the issue. It is OK to cross post, just state that you have done so and provide a link to your other threads. It is frowned upon to double post on the same site. If your original post does not describe what you really want, then simply amend that same thread and state in the amended portion that it supersedes the previous post. You do not need a new thread, because when you amend the old one, it goes into a new queue based on the time and date of the amendment. As the site monitor pointed out, it is all explained at:

Excelguru Help Site - A message to forum cross posters