Excel 2010 - Tabs created, now need to copy from external source
I was forced to start to learn this by my employer. Unfortunately I was not given much time to prepare and I need to give results soon :-)
Here is something I was able to put together with assist of this forum - it's creating tabs for each day and naming them properly:
Sub Testovanie() ' ' Testovanie Macro ' ' Keyboard Shortcut: Ctrl+a ' Dim pocet_tabov As Integer Dim netusim As Integer Dim sheet_meno As String Dim string_pre_datum As String Dim zadany_mesiac As Integer Dim datum As Date zadany_mesiac = 13 While (zadany_mesiac < 1) Or (zadany_mesiac > 12) zadany_mesiac = Val(InputBox("Numeric month?")) If zadany_mesiac = 0 Then Exit Sub Wend Application.ScreenUpdating = False string_pre_datum = Str(zadany_mesiac) & "/1/" & Year(Now()) datum = CDate(string_pre_datum) For pocet_tabov = 1 To 10 sheet_meno = Format((datum + pocet_tabov - 1), "dd.MMM.yyyy") If Month(datum + pocet_tabov - 1) = zadany_mesiac Then If pocet_tabov <= Sheets.Count Then If Left(Sheets(pocet_tabov).Name, 5) = "Sheet" Then Sheets(pocet_tabov).Name = sheet_meno Else Sheets.Add.Move after:=Sheets(Sheets.Count) ActiveSheet.Name = sheet_meno End If Else Sheets.Add.Move after:=Sheets(Sheets.Count) ActiveSheet.Name = sheet_meno End If End If Next pocet_tabov For pocet_tabov = 1 To (Sheets.Count - 1) For netusim = pocet_tabov + 1 To Sheets.Count If Right(Sheets(pocet_tabov).Name, 10) > _ Right(Sheets(netusim).Name, 10) Then Sheets(netusim).Move before:=Sheets(pocet_tabov) End If Next netusim Next pocet_tabov Sheets(1).Activate Application.ScreenUpdating = True End Sub
Now I need to copy prepared template from for example "C:\Troll\Template.xlsx" into all of theese created sheets. Additionally, template includes this formula: ='C:\Troll[source.xls]1.febr'!$U$33
I need this one to be updated in every new sheet. So the sheet with name 01.Feb.2014 needs to have template copied from [source.xls]1.febr'!$U$33, second sheet 02.Feb.2014 needs to have [source.xls]2.febr'!$U$33 and so on.
I was trying to do the copy - that worked. However I'm not able to join it with this one to be one big script.
Public Function kopirovanie(sheet_meno As String) Dim bWasClosed As Boolean Dim cesta As String Dim zdroj As Workbook Dim ciel As Workbook 'Set ciel = Workbooks("template for copy.xlsx") Set ciel = ActiveWorkbook ' for testing ' just in case the source wb is already open... On Error Resume Next ' avoid the error if not open Set zdroj = Workbooks("template for copy.xlsx") On Error GoTo 0 If zdroj Is Nothing Then bWasClosed = True cesta = "C:\Project Tata\Kopirovanie\" Set zdroj = Application.Workbooks.Open(cesta & "template for copy.xlsx") End If zdroj.Worksheets("Sheet1").Copy before:=ciel.Worksheets("Sheet1") If bWasClosed Then zdroj.Close False ' close without saving End If End Function
the function is supposed to be called after this
If pocet_tabov <= Sheets.Count Then If Left(Sheets(pocet_tabov).Name, 5) = "Sheet" Then Sheets(pocet_tabov).Name = sheet_meno
But I get error that copying is out of range. I think that I need to specify that it should copy regardless of the Tab name. Or actually I want it to copy into Active sheet...
the error is "Run-time error'9'" Subscript out of range.. and it marks me this one yellow: zdroj.Worksheets("Sheet1").Copy before:=ciel.Worksheets("Sheet1")
!! Look for the comments - part of this was already solved.
Now to continue with changing formula: I have two docs. Lets call them Source.xls and Results.xls Results doc has the macro you've wrote in it. That means we've copied 1 table that is exactly the same in all the newly created sheets - that's a part fo the job. However if I would do this with the table I have I would end up with Workbook created for 31 days of the month where is table with formula " ='C:\Troll[data_source.xls]1.febr'!$U$33 " .. this would end up with every day of Results showing results of the 1.st february of the data_source.
I need worksheet that was created for 1st feb, to get data from 1st feb, sheet for 2nd to get data from 2nd feb and so on.. Please be aware that source of table with formula and source of data which formula refers to are 2 different workbooks
I think this macro meets the first part of your requirement.
I have used your variable names when I am confident that I understand then. I have used my own names for other variables. I suggest you avoid renaming them until we have met your entire requirement.
I have not explained my new code. I did not want to spent time doing so if it does not meet your requirement. I am happy to explain anything you want to understand.
I use Excel 2003 so my extensions are different to yours. Change "xls" to "xlsx" before trying the macro.
I have three workbooks:
- The workbook containing the macro.
- The workbook containing the template worksheet. I have used your name for this workbook (except for the extension) but have changed the path to the folder holding the macro workbook.
- The workbook created by the macro. I have named this Format(datum, "yyyy mmm"). Again I have changed the path to the folder holding the macro workbook.
You can change the paths immediately or you can wait until we have finished development.
Edit The remainder of this answer has been replaced.
The revised code below now updates the formula in cell C3 of each sheet created in WbookCreate. I believe I have made the correct change so the formula references the correct worksheet in workbook Source.xlsx.
However, I have made another change. In the original code, I named the created sheets as "dd.MMM.yyyy". I believe that was incorrect and I should have named then as "d.MMM". However, in the new code I name them as "d" and have added a statement to adjust the TabRatio. This means that all the tabs are visible at the same time. This is just a demonstration of what is possible; you can easily change to any name you prefer.
Option Explicit Sub CreateDailySheets() Const WbookCopyName As String = "template for copy.xls" Dim datumCrnt As Date Dim datumStart As Date Dim Formula As String Dim InxWbook As Long Dim InxWsheet As Long Dim PathCopy As String Dim PathCreate As String Dim PosLastSquare As Long Dim PosLastQuote As Long Dim WbookCopy As Workbook Dim WbookCopyWasClosed As Boolean Dim WbookCreate As Workbook Dim WbookThis As Workbook Dim zadany_mesiac As Long Set WbookThis = ThisWorkbook ' These set the paths for the template workbook and the workbook to be ' created to that for the workbook containing the macro. Change as ' required. PathCopy = WbookThis.Path PathCreate = WbookThis.Path ' Check for template workbook being open WbookCopyWasClosed = True For InxWbook = 1 To Workbooks.Count If Workbooks(InxWbook).Name = WbookCopyName Then WbookCopyWasClosed = False Set WbookCopy = Workbooks(InxWbook) Exit For End If Next If WbookCopyWasClosed Then ' Template workbook is not open so open it Set WbookCopy = Workbooks.Open(PathCopy & "\" & WbookCopyName, True) End If ' Create an empty workbook Set WbookCreate = Workbooks.Add ' WbookCreate is now the active workbook ' Get the month of the current year for which workbook is to be created zadany_mesiac = 13 While (zadany_mesiac < 1) Or (zadany_mesiac > 12) zadany_mesiac = Val(InputBox("Numeric month?")) If zadany_mesiac = 0 Then Exit Sub Wend 'Calculate first day of target month datumStart = DateSerial(Year(Now()), zadany_mesiac, 1) datumCrnt = datumStart ' Loop until datumCrnt is within the next month Do While Month(datumCrnt) = Month(datumStart) ' Copy template worksheet from template workbook and name for day WbookCopy.Worksheets("Sheet1").Copy _ After:=WbookCreate.Worksheets(Worksheets.Count) With ActiveSheet ' In original code, I had "dd.MMM.yyyy" but I believe this should have ' been "d.MMM". However, I have changed to just "d" because with the ' TabRatio set to .7 all the tab names are visible. You can change this ' easily to your preferred value. .Name = Format((datumCrnt), "d") Formula = .Range("C3").Formula PosLastSquare = InStrRev(Formula, "]") PosLastQuote = InStrRev(Formula, "'") If PosLastSquare <> 0 And PosLastQuote <> 0 And _ PosLastQuote > PosLastSquare Then ' Sheet name is bracketed by PosLastSquare and posLastQuote ' Replace sheet name from template with one required for this sheet Formula = Mid(Formula, 1, PosLastSquare) & Format((datumCrnt), "d.MMM") & _ Mid(Formula, PosLastQuote) .Range("C3").Formula = Formula End If End With datumCrnt = DateAdd("d", 1, datumCrnt) Loop ' Delete default worksheet With WbookCreate ' The default sheets are at the beginning of the list Do While Left(.Worksheets(1).Name, 5) = "Sheet" Application.DisplayAlerts = False ' Surpress "Are you sure" message .Worksheets(1).Delete Application.DisplayAlerts = True Loop .Worksheets(1).Activate End With ActiveWindow.TabRatio = 0.7 WbookCreate.SaveAs PathCreate & "\" & Format(datumStart, "yyyy mmm") If WbookCopyWasClosed Then ' Template workbook was not open so close WbookCopy.Close SaveChanges:=False End If End Sub