Excel 2010 - Tabs created, now need to copy from external source - vba

Question

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.
Copying:
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

Answer 1

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