I'm VERY new to VBA so be gentle...
I'm attempting to automate the creation of a new tab in multiple workbooks. Every week, a new tab is manually created for the upcoming weekend.
I can get the code to search through a column to find the weekend that needs to be created, but then I would like it to move to the next column and do the same thing. On one tab of the "creator" workbook I have the weekends (Dates), on another I have the list of separate workbooks (Books) that will need a new tab created. The list of separate workbooks is grabbed by another script, then printed on both the Dates (in row 2 starting at C2) and Books (in column A starting in row 2) tabs. I have attached an example of the "creator" workbook I'm using. The newly created tab will should be renamed to the correct weekend. Example of Dates tab
Here is the code I'm using. It will created the first new tab, but stops after that.
Sub createNewTab()
Dim wB As Workbook
Dim wS As Worksheet
Dim bK As Worksheet
Dim r As Long
Dim i As Long
Dim c As Long
Dim fPath As String
Dim lastRow As Long
Dim lastDate As Long
Dim bDate As String
Dim eDate As String
Dim created As Long
Dim newBook As Workbook
Dim lDate As String
Dim nDate As String
Dim nBDate As String
Dim nEDate As String
Dim allSheets As Long
Set wB = Workbooks("Example Sheet Creator")
Set wS = wB.Sheets("Dates")
Set bK = wB.Sheets("Books")
lastRow = bK.Cells(Rows.Count, "A").End(xlUp).Row
lastDate = wS.Cells(Rows.Count, "C").End(xlUp).Row
allSheets = wS.Cells(2, Columns.Count).End(xlToLeft).Column
For c = 3 To allSheets
Do While c <= allSheets
For r = 2 To lastRow
If r <= lastRow And wS.Cells(2, c).Value = bK.Cells(r, 1).Value Then
For i = 3 To lastDate
While i <= lastDate And wS.Cells(i, 3).Text = "n"
bDate = Format(wS.Cells(i - 1, 1).Value, "mmm dd")
eDate = Format(wS.Cells(i - 1, 2).Value, "mmm dd")
nBDate = Format(wS.Cells(i, 1).Value, "mmm dd")
nEDate = Format(wS.Cells(i, 2).Value, "mmm dd")
fPath = bK.Cells(r, 2).Value
Application.ScreenUpdating = False
lDate = bDate & " - " & eDate
nDate = nBDate & " - " & nEDate
Set newBook = Workbooks.Open(fPath)
newBook.Sheets("Mar 14 - Mar 15").Copy After:=Worksheets(Sheets.Count)
'On Error Resume Next
ActiveSheet.Name = nDate
wS.Cells(i, 3).Value = "Y"
i = i + 1
Wend
Next i
r = r + 1
End If
Next r
c = c + 1
Loop
Next c
End Sub
Ideally, it would match the name in row 2 on Dates to the list in column A on Books. In the future, the name/order of the separate workbooks listed on the Books tab might change.
This uses 2 loops. Scan down the books sheet and for each book scan down the dates sheets. It checks the tab does not exist before creating it.
Sub createNewTab()
Const COPY_SHEET = "Mar 14 - Mar 15"
Dim wb As Workbook, ws As Worksheet, wsDates As Worksheet, wsBooks As Worksheet
Dim wbTarget As Workbook, wsTarget As Worksheet
Dim rng As Range, rngDates As Range
Dim iBookRow As Long, iLastBook As Long
Dim iDateRow As Long, iLastDate As Long
Dim iNameCol As Long, sYesNo As String, bOK As Boolean
Set wb = ThisWorkbook
Set wsBooks = wb.Sheets("Books")
Set wsDates = wb.Sheets("Dates")
iLastBook = wsBooks.Cells(Rows.count, 1).End(xlUp).Row
iLastDate = wsDates.Cells(Rows.count, 1).End(xlUp).Row
Set rngDates = wsDates.Rows(2)
Debug.Print iLastBook, iLastDate, rngDates.Address
Dim sName As String, sFilename As String, sTab As String
Dim count As Long, countWb As Long, n As Integer
' scan down the books sheet
For iBookRow = 2 To iLastBook
sName = wsBooks.Cells(iBookRow, 1)
sFilename = wsBooks.Cells(iBookRow, 2)
'Debug.Print sName, sFilename
' find column for this name on Dates
Set rng = rngDates.Find(sName)
If rng Is Nothing Then
MsgBox "Could not find " & sName & " on Dates sheet", vbExclamation
GoTo Skip
End If
iNameCol = rng.Column
' open target workbook
Set wbTarget = Workbooks.Open(sFilename)
countWb = countWb + 1
' scan down dates for sName
For iDateRow = 3 To iLastDate
sYesNo = wsDates.Cells(iDateRow, iNameCol)
sTab = Format(wsDates.Cells(iDateRow, 1), "mmm dd") & " - " & _
Format(wsDates.Cells(iDateRow, 2), "mmm dd")
' is create needed
If sYesNo <> "Y" Then
' check sheet doesn't exist
bOK = True
For Each ws In wbTarget.Sheets
If ws.Name = sTab Then bOK = False
Next
' create sheet
If bOK Then
With wbTarget
n = .Sheets.count
.Sheets(COPY_SHEET).Copy After:=.Sheets(n)
.Sheets(n + 1).Name = sTab
End With
wsDates.Cells(iDateRow, iNameCol) = "Y"
count = count + 1
Else
MsgBox sTab & " already exists in " & wbTarget.Name, vbExclamation
wsDates.Cells(iDateRow, iNameCol) = "Y"
End If
End If
'Debug.Print sName, iDateRow, sYesNo, sTab
Next
wbTarget.Close True
Skip:
Next
MsgBox count & " sheets created in " & countWb & " workbooks", vbInformation
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.