VBA - Loop through range, then copy range values into other sheet based on condition

[The Great SrH]

Hi guys,


I'm hoping somebody can help me with a code I need. I've attempted it below but it doesn't work, and it's probably completely wrong!


I have a worksheet called "Form" where the user will input data on a row by row basis. The maximum entries they can put on the sheet are 15 (15 rows) and the first row is A3-I3 (last row A17-I17).


I then have 2 replica worksheets which i want the code to output to - one called DFU and the other PeopleSoft.


I need the code to go down the "Form" worksheet and if Column B's content equals DFU, it will move that row to the "DFU" worksheet. If Column B equals PeopleSoft, it will move that row to the "PeopleSoft" worksheet.


When moving to the other worksheet, i need it to find the first available row in the range A3-I17.


Thanks for any help you can provide!

Sub test2()
Dim LR As Long, i As Long
With Sheets("Form")
    LR = .Range("A17" & Rows.Count).End(xlUp).row
    For i = 1 To LR
        If .Range("B" & i).Value = "DFU" Then
            .Range("A:I" & i).Copy
            Sheets("DFU").Range("A3:A17" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    Next i
End With

End Sub

 

[The Great SrH]

Works perfectly, thank you! The last issue I have is Row 18 seems to copying across to the extra sheets (there's merged cells, and it messes up the sheets)

 

[vcoolio]

Ah yes. Sorry. We needed to hard code the filter column which is currently dynamic. Hence, change this line of code:-

With ws.Range("B2", Range("B" & Rows.Count).End(xlUp))

to

With ws.Range("B2:B17")

Cheerio,
vcoolio.

 

[The Great SrH]

Ah yes. Sorry. We needed to hard code the filter column which is currently dynamic. Hence, change this line of code:-

With ws.Range("B2", Range("B" & Rows.Count).End(xlUp))

to

With ws.Range("B2:B17")

Cheerio,
vcoolio.

Works perfectly. Thanks for all your help!

 

[vcoolio]

You're welcome SrH. I'm glad to have been able to assist and thanks for the feedback.

I think that you mentioned in an earlier post that you only wanted data from Columns A:I transferred to the destination sheets so here is the code again allowing for that:-

Sub Test()

    Dim ar As Variant, i As Integer
    Dim ws As Worksheet: Set ws = Sheets("Form")
    ar = [{"DFU","PeopleSoft";"DFU","PeopleSoft"}]

Application.ScreenUpdating = False

    For i = 1 To UBound(ar, 2)
        With ws.Range("B2:B17")
                    .AutoFilter 1, "*" & ar(2, i) & "*"
                    .Columns("A:I").Offset(1, -1).Copy Sheets(ar(1, i)).Range("A17").End(3)(2)
                    Sheets(ar(1, i)).Columns.AutoFit
                    .AutoFilter
        End With
 Next i
    
Application.ScreenUpdating = True

End Sub

Cheerio,
vcoolio.