I need help with creating a macro that can automatically copy data from different worksheets and put it into a master worksheet for a report. The problem is that it is on multiple rows on different worksheets and I don't want it to leave empty rows between if I just use the usual worksheet copy way. Please help
The easiest way to do this would be to add a selection criteria to your dataset. So, in the following code, I have added an asterisk "*" in Column A (for each sheet) as the criteria.
Sub CopyData()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Integer
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name = "Master" Then GoTo NextSheet
ws.Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
For Each cell In Range("A2:A" & lRow)
If cell.Value = "*" Then
Range(Cells(cell.Row, "A"), Cells(cell.Row, lCol)).Copy
Sheets("Master").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next cell
NextSheet:
Next ws
Sheets("Master").Range("A1:A" & Rows.Count).ClearContents
Sheets("Master").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Data transfer complete", vbExclamation
End Sub
With this code, whichever row you place an asterisk by (ensure this is in Column A), in whichever sheet, the row of data will be copied to the "Master" sheet. The criteria is left behind.
We can add an additional row of code if you want the transferred data cleared from the worksheets supplying the "Master" sheet. As the code is now, it clears the "Master" sheet prior to the data transfer to prevent duplicates while the data remains in each of the supplying sheets.
Vcoolio, thank you for taking the time. However, when I copied the code and added the criteria, it is still not updating. Am I doing something wrong. Can I upload the document for you to see what's going on? Appreciate the help
Vcoolio, thank you for taking the time. However, when I copied the code and added the criteria, it is still not updating. Am I doing something wrong. Can I upload the document for you to see what's going on? Appreciate
Having now seen your workbook, its come to light that the problem is being caused by the merged cells. I unmerged all the cells in your work book, including in the "Master" sheet and this slightly amended code now works ok:-
Sub CopyData()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Integer
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name = "Master" Then GoTo NextSheet
ws.Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(5, Columns.Count).End(xlToLeft).Column
For Each cell In Range("A5:A" & lRow)
If cell.Value = "*" Then
Range(Cells(cell.Row, "C"), Cells(cell.Row, lCol)).Copy
Sheets("Master").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next cell
NextSheet:
Next ws
MsgBox "Data transfer complete", vbExclamation
Sheets("Master").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
The merged cells can be reformatted without merging, they may just need a little more space. Also, remove the word "criteria" from wherever you have placed it in Column A on each sheet.
Thank you so much. My last question would be when I update the master, it duplicates, What code can I add to clear the contents before updating so I don't have duplicate. You have been very helpful thanks again.
Hi TrowaD,
Thank you for helping me. I copied that code and it doesn't work. I've tried everything but it seems imposible. I've uploaded my document maybe you can see what am doing wrong. I want excel to pick up the rows on the other worksheets with a * as Vcoolio advised and before it copies to master to delete the contents in the master so it doesn't duplicate. Let me know what you think. Thanks again
Here is my drop box link with the document.
https://www.dropbox.com/s/vpk6m8kxc5k6ye7/Test%20Planning%20Worksheet%20Western%20Vicariate%20-%20Copy.xlsm?dl=0
I'm back. But not for long. I have to leave again tomorrow for another stint in the wilderness.
The following amended code should work for you:-
Sub CopyData()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Integer
Application.ScreenUpdating = False
Sheets("Master").Select
Sheets("Master").Range("B5:U" & Rows.Count).ClearContents
For Each ws In Worksheets
If ws.Name = "Master" Then GoTo NextSheet
ws.Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(5, Columns.Count).End(xlToLeft).Column
For Each cell In Range("A5:A" & lRow)
If cell.Value = "*" Then
Range(Cells(cell.Row, "C"), Cells(cell.Row, lCol)).Copy
Sheets("Master").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next cell
NextSheet:
Next ws
Sheets("Master").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
This is the latest work book that you uploaded to DropBox.
I hope you don't mind, but I had a good search through your work book and found a number of little things that interrupted the code and adjusted accordingly. It should all be OK now, I think!
BTW, I removed the message box as it became somewhat annoying!
You can click on the blue "Summarise" button to activate the code.
@ Trowa:-
Thanks for looking after the shop while I was away. Much appreciated.
By the way, what was distracting my code. I have it running on my larger worksheet but when i add a button for the summary it doesn't pick up the other worksheets, while the one you uploaded works perfect. What was it that you changed so I can change on my final. The macro works but the button skips some rows. Thanks again
into your work book. I've made a couple of minor adjustments.
In the "Master" sheet, if the headings are in merged cells (rows 3 & 4), unmerge them and format the headings just in row 3 before applying the adjusted code from above.
Vcoolio, you've been super helpful but my workbook has a mind of its own. I did everything as you said and the code works fine, but when I assign the button to the macro, it only picks up the first worksheet and leaves the rest. However, when I go to macro and run it from the developer tab, it copies everything as it should. Wondering what it could be with the button. It's so much little things....whew. Thanks for experts like you. I uploaded my sheet maybe you can help. Hope the desert was good. Feels like I need a desert escape as well. Thanks again. Here is the workbook.
I have gone right through your work book and all seems in order. I found four entries with the asterisk which have data in the row beside it and they all transfer nicely once your button is pressed. I tried additional random entries and they all transferred to the Master sheet nicely.
There are a lot of rows marked with the asterisk but no data in them so these rows will not be transferred over.
The other thing to remember, and I don't think that I told you previously, is that the code does require an entry in Column C (Vicariate) for it to execute. This column is the code's reference and it "homes in", so to speak, on the cell reference in Column C from the bottom of the sheet (by rows) and from the far, far right of the sheet (by columns). A bit like cross hairs on a scope. These two lines of code are the ones involved with the "cross hair' scenario:-
and when one cell is found, the code moves on to the next cell referenced by:-
Next cell
and then, when one sheet is searched:-
NextSheet;
Next ws
in the code.
Just to be sure, re-assign the macro to the button:-
- Right click on the button.
- Select Assign Macro.
- In the Assign Macro box which appears, click on CopyData.
- Click OK.
hello vcoolio,
For whatever reason it worked for you but when i press it, it doesn't even after i assign it to macro. I figured it wasn't the code since the code worked fine when I ran it straight from the run macro menu. I am glad actually that it picks up just the column C with an entry so all that is okay and that's why I had the 4 random ones with entries to test it. I will try it again tomorrow and see if it works. will let you know. I think in the past month I've gone through an excel boot camp. Didn't know it was capable of this much. You've been a great help so thank you again.
Yea just tried it and it only populates the master from my first worksheet from the button again. Not even sure why that is anymore. Did it work on yours exactly with the button and the same arrangement when I uploaded it. It must be my excel software then....wow
Everything works fine at this end still, especially in your actual work book.
Lets go down another road. Try this code instead:-
Sub CopyItAgain()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim DestSht As Worksheet
Dim DestRow As Long
Dim LastRow As Long
Set DestSht = Worksheets("Master")
DestRow = DestSht.Range("B" & Rows.Count).End(xlUp).Row + 1
For Each ws In Worksheets
A = ws.Name
Select Case ws.Name
Case "PSM", "CCHD", "DOI", "FG", "FSW", "GS", "MM", "SMD", "PM":
With ws
.UsedRange.AutoFilter Field:=1, Criteria1:="*"
.UsedRange.Offset(4, 2).Copy
DestSht.Cells(DestRow, 2).PasteSpecial xlPasteValues
.UsedRange.AutoFilter
End With
DestRow = DestSht.Range("B" & Rows.Count).End(xlUp).Row + 1
End Select
Next ws
Sheets("Master").Range("B3:U" & Rows.Count).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), Header:=xlYes
Application.ScreenUpdating = True
End Sub
This code actually uses the AutoFilter function and won't need a cell to home in on so this code will copy whatever you have on a row marked with the asterisk (even if the Vicariate in Column C is not filled in).
Enter this code in a separate module and just run it from Visual Basic without a button. If it works OK from there, then delete the old button and start afresh by creating a new button and assign the new macro to it. It would probably be best to do this in a copy of your work book instead of your actual work book.
Hi Vcoolio,
I took a break from my workbook. i'll try this code and see how it works. Hope this is it. Thanks again. its snowy in the east so I have some time to play with it. Thanks again.
I thought that you had given up! I had a picture of you way out in the wilderness, in a remote outback hotel, tumbleweeds blowing around, sitting at the bar, four empties in front of you with a top-up on the way, head in hands saying "Why me?" !!
Vcoolio, honesty I wanted to do just that. Was close to asking why me? The code seems to be working better with the button. One last thing is that after it copies, it leaves the master highlighted on the cells. Is there a way to unselect.
Also when share my workbooks, they don't work sometimes in the other computer. Is there a setting I need to look activate to make it work through. Thanks again and hope you are doing well.
Glad to know that its working now. Its still working nicely on this end (both codes!). As for the high-lighting, if you are referring to the blue coloured high-lighting once copying/pasting is done, just click away. This is Excel's way of telling you that the task is done. Its part and parcel of the whole process.
As for the settings, click on the File tab in your work sheet (top left) then select Options. Next, select Trust Centre and then click on the Trust Centre settings button. On the left hand side of the dialogue box that pops up, you will see a list of categories. Go through each one, but mainly:-
You're an excel sage for sure. The settings worked great. The second code is working but one question is that after entering more info in the worksheets and hitting update, it is not updating some of the new info. Do you think we need to add a clearcontents on the master before updating so we can capture the new information properly. I think that might be the only. Always something with excel....whew. But am enjoying the ride. Thanks again old friend.
Excellent! I'm glad it has all worked out for you.
As for worksheet protection, keep it simple and use the Excel inbuilt sheet protection function: Review Tab--->Changes Group--->Protect Sheet or Work Book.
It will allow you to also use password protection just in case you need to keep "others" out of your Work Book.
I'll leave it to you to mark this thread as solved. I'm sure that even this will give you some satisfaction!
https://www.dropbox.com/s/azbbvcnp4e8flsp/Planning%20Worksheet%20Western%20Vicariate%20-%20Copy.xlsm?dl=0