Duplicate rows from multiple worksheetsSolved/Closed

Question

Hello, 

I have a workbook that I'm hoping will be the template for a monthly log. It is almost done, but I cannot figure out the best way to perform one vital function.

There is one worksheet for each day of the month, plus another sheet labelled 'Follow Up'. On the Follow Up page I want to create a button that will run a macro that copies all rows showing 'Follow Up' in column G. When these are marked as 'Complete' if the button is pressed again, it should delete old entries from the Follow Up page.

In other words, I want to be able to see which items need following up most urgently at the click of a button. Only items currently marked with 'Follow Up' should show on that page.

I have seen something similar done before, but it was long before I knew anything about coding (I still have only very limited knowledge), so I didn't even think to look at how it was done.

Any help with this matter would be much appreciated.

Thanks in advance.

vcoolio · Answer

Hello Iksta,

When a row of data is marked as "Complete" on the Follow Up sheet, will it also be in Column G?

Cheerio,
vcoolio.

vcoolio · Answer

Hello Iksta,

The following two codes should do the task for you.

Firstly:-

Sub FollowUp()

Dim ws As Worksheet

Application.ScreenUpdating = False

Sheet1.UsedRange.Offset(1).ClearContents

For Each ws In Worksheets
If ws.Name <> "Follow Up" Then
With ws.[A1].CurrentRegion
             .AutoFilter 7, "Follow Up", , , 7
             .Offset(1).EntireRow.Copy
             Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
             .AutoFilter
             End With
       End If
Next ws

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

This code will filter Column G in all sheets (except the Follow Up sheet) for the criteria "Follow Up". It then transfers the relevant rows of data to the Follow Up sheet. Place the code in a standard module and assign it to a button.

Secondly:-

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("G:G")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

If Target.Value = "Complete" Then
Target.EntireRow.Delete
End If

End Sub

When you type the word Complete in any cell in Column G of the Follow Up sheet then click away (or press enter or down arrow), the relevant row of data will be deleted from the Follow Up sheet. This code does not need a button and needs to be placed in the Follow Up sheet module. So, to implement this second code:-

- Right click on the Follow Up sheet tab.
- Select "View Code" from the menu that appears.
- In the big white field that then appears, paste the second code.

Following is a sample workbook that I have prepared for you so that you can see how the codes work:-

http://ge.tt/4rAUiip2

Click on the "RUN" button to see the data from the source sheets transferred to the Follow Up sheet.

When you have some data in the Follow Up sheet, overwrite "Follow Up" in any cell in Column G with "Complete" then click away (or press enter or down arrow). You'll note that the relevant row of data is deleted.

I hope that this helps.

Cheerio,
vcoolio.

vcoolio · Answer

Hello Iksta,

The code slightly amended as follows should do the trick:-

Sub FollowUp()

Dim ws As Worksheet

Application.ScreenUpdating = False

Sheet1.UsedRange.Offset(8).ClearContents

For Each ws In Worksheets
If ws.Name <> "Follow Up" Then
With ws.[A8].CurrentRegion
             .AutoFilter 7, "Follow Up", , , 7
             .Offset(1).EntireRow.Copy
             Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
             .AutoFilter
             End With
       End If
Next ws

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The second code should still be OK as it is.
Test it in a copy of your actual work book.

Cheerio,
vcoolio.

vcoolio · Answer

Hello Iksta,

You're welcome. I'm glad that I was able to help.

Cheerio,
vcoolio.

Duplicate rows from multiple worksheets

4 responses

Similar discussions

Subscribe To Our Newsletter!