VBA to loop through sheet and copy contents to a new workbook

Mjoza

Board Regular
Joined
Aug 31, 2011
Messages
172
Hi all,

Can someone please help me with a code. I have a workbook with sheet1 which contains data that I want to copy that data to different workbooks (Month tab) based on the values in column a.

The data in Sheet1 is sorted by column a and the workbooks which the data has to be copied to are named based on column a values.

For example the table below will be the values in sheet1[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]YEAR[/TD]
[TD]Month[/TD]
[TD]QTY[/TD]
[TD]Code[/TD]
[TD]CONFRM[/TD]
[/TR]
[TR]
[TD]IND[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]12[/TD]
[TD]2345[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]IND[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]45[/TD]
[TD]2345[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]IRE[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]646[/TD]
[TD]3345[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]IRE[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]35[/TD]
[TD]3345[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]SGP[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]35[/TD]
[TD]4588[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]USA[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]45[/TD]
[TD]1101[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]USA[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]452[/TD]
[TD]1102[/TD]
[TD]Y[/TD]
[/TR]
</tbody>[/TABLE]

The destination workbooks are saved in a different folder (named Completed) on the desktop. In that folder there are excel files with with name that begin with names like in the Name column above ie IND Monthly Data, IRE Monthly Data, USA Monthly Data etc. There are a lot more than whats shown above so I would like to make the code dynamic.

What I would like to do is to have the code to loop through the data in sheet1 and open files saved in the Completed folder and save the data.

So for example the code will copy the information in the sheet1 to 4 different workbooks and save each and close. The data will be pasted into cell B2 because the destination file already has headers.

Example: workbook "IND Monthly Data" and Month tab will have the following
[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]YEAR[/TD]
[TD]Month[/TD]
[TD]QTY[/TD]
[TD]Code[/TD]
[TD]CONFRM[/TD]
[/TR]
[TR]
[TD]IND[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]12[/TD]
[TD]2345[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]IND[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]45[/TD]
[TD]2345[/TD]
[TD]Y[/TD]
[/TR]
</tbody>[/TABLE]

Example: workbook "IRE Monthly Data" and Month tab will have the following
[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]YEAR[/TD]
[TD]Month[/TD]
[TD]QTY[/TD]
[TD]Code[/TD]
[TD]CONFRM[/TD]
[/TR]
[TR]
[TD]IRE[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]646[/TD]
[TD]3345[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]IRE[/TD]
[TD]2015[/TD]
[TD]October[/TD]
[TD]35[/TD]
[TD]3345[/TD]
[TD]Y[/TD]
[/TR]
</tbody>[/TABLE]

Thank you so much in advance.

Mjoza
 
Hi Nick30075
....... trying to run the vb code posted a[/SUB]bove by WarPigl3t.
Opened a new xlsm, copied the code above into a new module and when stepping thru, the lastRow assignment is choking ...!

_ ...Weird... I just did what you did and no problems, with and without data in a sheet.

_ 1 ) What is your File name and what is your sheet name)

_ 2) Have you tried my code?

Alan
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Hi DocAElstein,
Your code ran fine. Don't know why I'm getting junk from the other code!
You asked in your previous note What I'm trying to do. What I'm really trying to do is detailed in this post:
http://www.mrexcel.com/forum/excel-questions/899888-generate-subset-table-master-table.html

I was going to try and retrofit the code above in order to try and accomplish the task detailed in my post.

Please take a look, any help/insight into my solution is greatly appreciated!
 
Upvote 0
@ Nick30075
Hi Nick30075,

WarPigl3t’s code works fine by me and is the professional alternative to mine. If you got mine working then you can see it solves a fairly a different issue, or at least does a lot of File and Folder creating you do not need.
I am still very puzzled how WarPigl3t’s code errors for you right at the start whilst mine runs successfully. I did see that WarPigl3t’s would need this modification
nameValue = CStr(Workbooks(mainWB).Sheets(mainSht).Range(nameColumn & r).Value)
for you to get any results out of it, but that is well into the code, and these codes are really doing much more than you want.

Your requirement in the other Thread looks fairly simple. You need initially to find a cell with ; in then Split that string to get the ID to do then something vaguely along the lines of what the codes here do but without all the File and Folder creating stuff.

Have a go, I may be able to help later, if you still need help.

Alan
 
Upvote 0
Change this:
Code:
mainWB = getWorkbookName(ThisWorkbook.Name)
to just this:
Code:
mainWB = ThisWorkbook.Name

You should always include the extension when referring to a workbook by name.
 
Upvote 0
......
You should always include the extension when referring to a workbook by name.

Hi Rory,
Ah, interesting... and the code still works if you do that...
I always wondered why I could have an extension up ( add the .xlsm ) bit if i wanted to , when saving or not have an extension and it worked the same as if i did have an extension
So if you are saying it is better practice to have an extension at the time ( add the .____ bit) then that is a good Tip, Thanks






I’ll have an experiment with that later . – Might have consequences on what arguments you use with a
SaveAs
Line, which are often a bit tricky to get right
Alan
 
Upvote 0
No. I mean when you pass a workbook name to the Workbooks collection you should always include the file extension.
 
Upvote 0
@Nick
You pasted a link to a thread that has the problem you are working on. I wrote code and pasted it to your thread. Your requirements are quite different than what we needed in this thread. Your problem was much easier to solve that I did it on my tablet while taking a dump. Most painful code I ever wrote.
 
Upvote 0
@ Nick30075 and @ Rory and @ WarPigl3t

_ .....Ahh, I think 10 hours later I my have got the point.....
... when you pass a workbook name to the Workbooks collection you should always include the file extension.
I have some vague memeory of
Workbooks(“FileName”)
Once not working when
Workbooks(“FileName.xlsm”)
Did....

_ ... I could not get that error to come up again, but along the way i did a lot of experiments in the codes below whereby I erected Files with the same basic name but with different extensions ( .xls .xlsx .xlsm ). I repeated the code lines given below, in different order, swapped names around , and , ( as it appeared later importantly ) closed all Workbooks and opened them again in different order of opening before repeating all the code lines.
_ It would appear that if you reference a Workbooks collection ( which is i believe the collection of all Open Workbooks ) without the extension, it will go to the first File opened with that basic Filename, regardless of the extension that File has.
_ So regarding the initial problem Nick30075 had, it could, for example be that initially a file was made and saved say with .xlsx and the file was then saved with the basic name but .xlsm extension. My experiments suggest if both Files were then opened but for some reason the .xlsx file was firstly opened then that could somehow explain the possibility of the error at line
Workbooks(mainWB).Sheets(mainSht).Range("A" & Rows.Count).End(xlUp).Row
( If only one File is open, problems , I think should not occur.... or possibly yes if the Other ( wrong ) file was opened first, but then closed as the Code went on etc. etc.

_ I coincidentally used in my code
Set wbMain = ThisWorkbook
Which gives the full Filename including erecting the extension to it.
_ In any case including erecting the correct extension would appear to solve the problem. - There may well be something more to it than that, but for now I have had enough with experimenting! If I notice any more general rules on this then I will post further.......

_ This may of been what Rory was suggesting in Post #14, or he was pointing out that it is good practice, which the points raised here supports ( Or he just made it up, and guessed right from instinct – i believe he may have some experience with VBA things ;) )

Alan

Test codes i used ( as mentioned swapping lines around, and changing order of opening the three erected files will yield different results )

Rich (BB code):
Sub FileErectionTestie_1()
Rem Exp1 All three files open .xls   .xlsx    .xlsm
Dim WBxlsx As Workbook, WBxlsm As Workbook, WB As Workbook
Set WB = Workbooks("ViskasVerticalsMaster dataMjozaWarPig")
Set WBxlsm = Workbooks("ViskasVerticalsMaster dataMjozaWarPig.xlsm")
Set WBxlsx = Workbooks("ViskasVerticalsMaster dataMjozaWarPig.xlsx")


WBxlsm.Worksheets.Item(1).Range("A2:A10").Clear
Let WBxlsm.Worksheets.Item(1).Cells(2, 1).Value = """.xlsm"" extended erection 2 :)" 'Went to .xlsm
WBxlsx.Worksheets.Item(1).Range("A2:A10").Clear
Let WBxlsx.Worksheets.Item(1).Cells(3, 1).Value = """.xlsx"" extended erection 3 :)" 'Went to .xlsx
WB.Worksheets.Item(1).Range("A2:A10").Clear
Let WB.Worksheets.Item(1).Cells(4, 1).Value = "  impudent errection 4 :)" 'Went to .xlsx, or xls, or xlsm
WBxlsm.Worksheets.Item(1).Range("A2:A10").Clear
Let WBxlsm.Worksheets.Item(1).Cells(5, 1).Value = """.xlsm"" extended erection 5:)" 'Went to .xlsm
WB.Worksheets.Item(1).Range("A2:A10").Clear
Let WB.Worksheets.Item(1).Cells(6, 1).Value = "  impudent errection 6 :)" 'Went to .xlsx

Dim WBxls As Workbook
Set WBxls = Workbooks("ViskasVerticalsMaster dataMjozaWarPig.xls")
WBxls.Worksheets.Item(1).Range("A2:A10").Clear
Let WBxls.Worksheets.Item(1).Cells(7, 1).Value = """.xls""  errection 7 :)" 'Went to .xls
WB.Worksheets.Item(1).Range("A2:A10").Clear
Let WB.Worksheets.Item(1).Cells(8, 1).Value = "  impudent erjection 8 :)" 'Went to .xlsx, or xlsm, or


End Sub

Sub FileErectionTestie_2()
Rem 2 .xls   .xlsm   open
Dim WB As Workbook, WBxlsm As Workbook
Set WB = Workbooks("ViskasVerticalsMaster dataMjozaWarPig")
Set WBxlsm = Workbooks("ViskasVerticalsMaster dataMjozaWarPig.xlsm")

WB.Worksheets.Item(1).Range("A2:A10").Clear
Let WB.Worksheets.Item(1).Cells(9, 1).Value = "  impudent erjection 9:)" 'Went to .xls or .xlsm depending on which was opened first

End Sub
 
Last edited:
Upvote 0
Thanks WarPigl3t, I'll check it out & let you know. Glad I gave you something to do in your down time!
 
Upvote 0

Forum statistics

Threads
1,223,277
Messages
6,171,147
Members
452,382
Latest member
RonChand

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top