If conditions are met, copy to new worksheet

[Smucka]

Hi all,

I'm a bit of a newbie when it comes to VBA, so I'm hoping some good soul can help me out with my problem. I tried searching for a solution and found some things, but not exactly what I'm looking for.

I have a worksheet with some data (see screenshot). This data is updated weekly by adding or removing comments to damaged articles. What I'd like to do is, if there is a comment for a damaged article, I'd like excel to copy that whole row to another sheet. If that comment is deleted next week, the row wouldn't be copied. The screenshot provided is just an example, the real worksheet contains about 5k rows and 15 columns. I can provide more info if it's needed. Any help is greatly appreciated. Thanks!

Edit: what I mean by comment is the comment written in row, not the "red arrow" comment.

[Logit]

.
Here is one method :

Option Explicit

Sub CpyRws()
Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("Sheet2")  'specify sheet name here to paste to
    x = 2   'begins pasting in Sheet 2 on row 2
    
    Application.ScreenUpdating = False
    
            With Worksheets("Sheet1")
                Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col B
                Set Rng = .Range(.Cells(2, "B"), .Cells(Rws, "B"))
                For Each c In Rng.Cells
                    If c.Value <> "" And c.Offset(0, 2).Value <> "" Then 'searches for non-blank cells
                        c.EntireRow.Copy
                        ws.Range("A" & x).PasteSpecial Paste:=xlValues
                        x = x + 1
                    End If
                Next c
            End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
ws.Activate
ws.Range("A1").Select
   
End Sub

[Smucka]

.
Here is one method :

Option Explicit

Sub CpyRws()
Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("Sheet2")  'specify sheet name here to paste to
    x = 2   'begins pasting in Sheet 2 on row 2
    
    Application.ScreenUpdating = False
    
            With Worksheets("Sheet1")
                Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col B
                Set Rng = .Range(.Cells(2, "B"), .Cells(Rws, "B"))
                For Each c In Rng.Cells
                    If c.Value <> "" And c.Offset(0, 2).Value <> "" Then 'searches for non-blank cells
                        c.EntireRow.Copy
                        ws.Range("A" & x).PasteSpecial Paste:=xlValues
                        x = x + 1
                    End If
                Next c
            End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
ws.Activate
ws.Range("A1").Select
   
End Sub

Hi,

thanks for your quick reply. Just tried this and it works flawlessly. Thank you very much for helping me out, this will surely save me countless hours of combing data. Would this code also work if I wanted to insert a button so the code would run on click?

[Logit]

.
Yup.

Paste the macro in a Regular Module.

Paste a CommandButton on the first sheet and attach it to the macro.

[Smucka]

.
Yup.

Paste the macro in a Regular Module.

Paste a CommandButton on the first sheet and attach it to the macro.

Hello, I just tried doing this and succeeded on first try. Thank you! It works as intended. This is a life saver.

So I got a new table today, which is really similar to this one, but I already have sheet2 and articles (without comments) on it. The problem now is, that on this sheet2, all articles are jumbled. How would I go about searching sheet1 for article which has a comment and copy pasting that comment to same article in sheet2 (but the article is not on the same row as in sheet1). I'm providing another screenshot so you'll know what I mean. I suspect this complicates things a bit. Also, sorry for asking so many (not so great) questions.