Reputation: 3
I'm very new to VBA and have been tasked with writing a macro.
I have a system generated file that looks like this
I should end up with three worksheets that look like this
That is, I am trying to find a way to copy the rows between "item 1" and "item 2", "item 2" and "item 3" etc. in all cases where the cells in columns D, E or F are not empty.
By browsing the forums I could find something to get me started, but I am not sure how to proceed. Any help would be appreciated. Thanks.
Sub CopyRows()
Dim r As Range, fr As String 'Item1
Dim c As Range, fc As String 'Item2
Dim StartR As Integer
Dim EndR As Integer
Dim NwRng As Range, Nwc As Range
Dim nwSh As Worksheet
fr = "Item 1"
fc = "Item 2"
Set r = Range("A:A").Find(what:=fr, lookat:=xlWhole)
Set c = Range("A:A").Find(what:=fc, lookat:=xlWhole)
If Not r Is Nothing Then
StartR = r.Row + 1
Else: MsgBox fr & " not found"
Exit Sub
End If
If Not c Is Nothing Then
EndR = c.Row - 1
Else: MsgBox fc & " not found"
Exit Sub
End If
Set NwRng = Range("D" & StartR & ":D" & EndR)
Set nwSh = Sheets.Add
For Each Nwc In NwRng.Cells
If Not IsEmpty(Nwc) Then Nwc.EntireRow.Copy nwSh.Cells(nwSh.Rows.Count, "A").End(xlUp).Offset(1)
Next Nwc
End Sub
Upvotes: 0
Views: 48
Reputation: 57683
Actually you can do that without looping just using autofilter. All you need is:
Use Autofilter
Filter for Description
not blank AND Set1
not blank and copy it.
Filter for Description
not blank AND Set2
not blank and copy it.
Filter for Description
not blank AND Set3
not blank and copy it.
Done.
No searching, no looping, no mess. The only thing you need to do in the end is cleaning up the columns you don't like.
Upvotes: 2