VBA 循环遍历行然后列

Question

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

Example of Books 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.

Answer 1

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