Copying Rows from 1 sheet to another based on a cell value

[JADownie]

Hello, I am hoping that someone might be able to give me some guidance here today.

Would something like this even be possible now with VBA, or am I dreaming when I think that this could be done....

First, on my sheet Summary delete all rows active rows on this sheet after last row in PivotTable1

Next, the same sheet Summary determine the first available empty row (skip 3 more)

Then look in cell B1 on sheet Summary, and in this blank row from above below copy over all rows from sheet AllData where B1 = same value in Column C on AllData sheet (also copy over header row 1)

 

[JADownie]

OK well I was ale to get the first part of my macro worked out here now to delete all rows active rows on this sheet after last row in PivotTable1

Now I am stuck with how to get my necessary rows to copy over from 1 sheet to another.

I need a macro to grab the value in cell B1 on sheet Summary, and copy and paste all rows from sheet AllData where B1 = same value in Column C on AllData sheet (also copy over header row 1)

Any tips here would be greatly appreciated!! Thanks!

 

[JADownie]

Forgot to mention, the new rows from AllData should be pasted into the first blank row on sheet Summary (which will be below my 2 pivot tables)

 

[JADownie]

I have the macro below which works for copying over rows based on a hard coded value, but I need to alter this now so that it can reference cell B1 on sheet Summary instead.

I appreciate any guidance here now. Thanks!

Sub CopyRows()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet


Set Source = ActiveWorkbook.Worksheets("AllData")

Set Target = ActiveWorkbook.Worksheets("Summary")

j = 1

For Each c In Source.Range("A1:A100000")

If c = "212456434" Then

Source.Rows(c.Row).Copy Target.Rows(j)

j = j + 1

End If


Next c
End Sub

 

[Domenic]

Try the following...

If c.Value = Target.Range("B1").Value Then

Although, I'm assuming that since B1 contains your criteria, you'll want to start pasting at Row 2 instead of Row 1. Otherwise, the criteria will be overwritten.

Hope this helps!

 

[JADownie]

Actually no, I would like the macro to ideally paste into the first available (well if possible skip 1 row) and then paste. Sometimes it might be row 10, other times it could be in row 50...

 

[Domenic]

Try the following instead...

Sub CopyRows()

    Dim c As Range
    Dim LastRow As Long
    Dim NextRow As Long
    Dim Source As Worksheet
    Dim Target As Worksheet
    
    
    Set Source = ActiveWorkbook.Worksheets("AllData")
    With Source
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    Set Target = ActiveWorkbook.Worksheets("Summary")
    With Target
        NextRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
    End With
    
    For Each c In Source.Range("A1:A" & LastRow)
        If c.Value = Target.Range("B1").Value Then
            c.EntireRow.Copy Target.Rows(NextRow)
            NextRow = NextRow + 1
        End If
    Next c
    
End Sub

Hope this helps!

 

[Domenic]

By the way, if the workbook running the code contains sheets "AllData" and "Summary", you should replace each reference to ActiveWorkbook with ThisWorkbook.

 

[JADownie]

Try the following instead...

Sub CopyRows()

    Dim c As Range
    Dim LastRow As Long
    Dim NextRow As Long
    Dim Source As Worksheet
    Dim Target As Worksheet
   
   
    Set Source = ActiveWorkbook.Worksheets("AllData")
    With Source
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
   
    Set Target = ActiveWorkbook.Worksheets("Summary")
    With Target
        NextRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
    End With
   
    For Each c In Source.Range("A1:A" & LastRow)
        If c.Value = Target.Range("B1").Value Then
            c.EntireRow.Copy Target.Rows(NextRow)
            NextRow = NextRow + 1
        End If
    Next c
   
End Sub

Hope this helps!

YES that worked!! THANK YOU!!

Would you be able to help me edit so that instead of the first blank row, it skips 2 rows first? Then would it also be possible to include the header rows (row 1 on AllData sheet) when it copying over?

That would make it PERFECT now PS You are my Hero. Thank You!!

 

[Domenic]

Is this what you mean?

Sub CopyRows()

    Dim c As Range
    Dim LastRow As Long
    Dim NextRow As Long
    Dim Source As Worksheet
    Dim Target As Worksheet
    
    
    Set Source = ActiveWorkbook.Worksheets("AllData")
    With Source
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    Set Target = ActiveWorkbook.Worksheets("Summary")
    With Target
        NextRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
    End With
    
    If NextRow > 2 Then
        'do nothing
    Else
        NextRow = 3
    End If
    
    Source.Rows(1).Copy Target.Rows(NextRow)
    
    NextRow = NextRow + 1
    
    For Each c In Source.Range("A1:A" & LastRow)
        If c.Value = Target.Range("B1").Value Then
            c.EntireRow.Copy Target.Rows(NextRow)
            NextRow = NextRow + 1
        End If
    Next c
    
End Sub