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.

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

Answers


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

Need Your Help

SkillSoft Web Service Issues

c# .net web-services

Using Visual Studio 2005 and C# .NET I was attempting to call methods from the SkillSoft API through their web service and have been running into issues when creating the instance. I started by add...

Faster search for files in Netbeans

search netbeans find

Is there an existing plugin or tweak that speeds up the "Go To File" search in Netbeans ? Compared to Eclipse, Netbeans search is way too slow specially if one has multiple large size projects.