VBA в Excel Переименование основного листа при копировании листа шаблона, а не именование скопированных листов после списка имен - PullRequest
0 голосов
/ 27 марта 2020

Моя цель - иметь два листа в качестве источников и дублировать один из них. В Master Sheet есть список имен для листов и ячейка на листе, а в Hidden есть шаблон, который должен быть реплицирован для каждой копии.

У меня есть код на двух листах: «thisworkbook» и 2 модуля.

Моя проблема: VBA в Excel Переименование мастер-листа при копировании листа шаблона, а не именование скопированных листов после списка имен. Обратите внимание - это работало, когда у меня было 10 имен, но как только я уменьшил или увеличил его, код не удался.

Модуль 1

Sub Create_sheets()
Dim masterSheet As Worksheet
Dim hiddenSheet As Worksheet
Dim NewSheet As Worksheet
Dim myBook As Workbook
Dim lastRow As Long
Dim i As Long
Dim namesColumn
    'Define your workbook - here set as the active workbook, assuming it contains masterSheet and hiddenSheet
Set myBook = ActiveWorkbook
    'Define your worksheets - The sheets are named "Master Sheet" and "Template" respectively
Set masterSheet = myBook.Worksheets("Master Sheet")
Set hiddenSheet = myBook.Worksheets("Hidden")
    'Define which column in your master tab the list is - here it's A i.e. column 1
    ''namesColumn = 1 or
namesColumn = 1
    'Find the last row of the sheets list
lastRow = masterSheet.Cells(masterSheet.Rows.Count, "A").End(xlUp).Row
'Cycle through the list - Assuming the list starts in column "A" from the 2nd row
' 'For i = 2 To lastRow
For i = 2 To lastRow
    With myBook
        ActiveWorkbook.Sheets("Hidden").Visible = True
        Application.ActiveWorkbook.Sheets("Hidden").Copy _
    Before:=Application.ActiveWorkbook.Sheets("Hidden")
        On Error Resume Next
        'Find name of the tab and naming the tab
        tabName = masterSheet.Cells(i, namesColumn)
    If Err.Number = 1004 Then
 Debug.Print cell.Value & " already used as a sheet name"
        End If
 On Error GoTo 0
    End With
ActiveWindow.DisplayGridlines = False
    ' 'ActiveSheet.Cells(i, 1).Value = tabName
ActiveSheet.Name = tabName
Next i
'delete form control button
ActiveSheet.Buttons.Delete
ActiveWorkbook.Sheets("Hidden").Visible = False
End Sub
Function WorkSheetName() As String
ActiveSheet.Activate
WorkSheetName = ActiveSheet.Name
End Function
Sub update_formula()
Range("B1").Select
    ActiveCell.FormulaR1C1 = "=WorkSheetName()"
    Application.Selection.Calculate
End Sub

Модуль 2

Sub LastCell_In_Sheet ()
    Dim LastCell As String
    Dim rng As Range

    Set rng = ActiveSheet.Cells
    ' Find the last cell
    LastCell = Last(3,rng)
    ' Select the last cell in Rng
    With rng.Parent
        .Select
        Range(LastCell, LastCell).Select
    End With
End Sub
Function Last (choice As Long, rng As Range)
'last cell in a sheet
    Dim lrw As Long
    Dim lcol As Long

    On Error Resume Next
    lrw = rng.Find(What:="'", _
            after:=rng.Cells(1), _
            LookAt:=x1Part, _
            LookIn:=x1Formulas, _
            SearchOrder:=x1ByRows, _
            SearchDirection:=x1Previous, _
            MatchCase:=False).Row
    On Error GoTo 0

    On Error Resume Next
    lcol = rng.Find(What:="'", _
            after:=rng.Cells(1), _
            LookAt:=x1Part, _
            LookIn:=xlFormulas, _
            SearchOrder:=x1ByColumns, _
            SearchDirection:=x1Previous, _
            MatchCase:=False).Column 
    On Error GoTo 0

    On Error Resume Next
    Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
    If Err.Nu=ber > 0 Then
        Last = rng.Cells(l).Address(False, False)
        Err.Clear
    End If
    On Error GoTo 0 

End Function

Лист1 («Основной лист» - список имен листов)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Application.Intersect(Target, Range("a5:a25")) Is Nothing Then

Dim strName As String

strName = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
On Error Resume Next
Sheets(strName).Select

Call LastCell_In_Sheet
    End If

End Sub

Лист 2 («Скрытый» лист - содержит шаблон, который необходимо скопировать для каждого имени в «Основном листе», а также ячейку). , B1, который имеет то же имя)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Application.Intersect(Target, Range("a1:f1")) Is Nothing Then

Dim strName As String

strName = ActiveCell.Value
Sheets("Master Sheet").Select
ActiveSheet.Range("C5").Select
End If
    'put the autofilter back on if it has been removed.
If ActiveSheet.AutoFilterMode = False Then Rows(4).AutoFilter
    'error handle the showalldata part
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0

End Sub
Private Sub Worksheet_Activate()
Call update_formula
    End Sub

ThisWorkbook

Private Sub Workbook_Open()

Worksheets("Master Sheet").Select
ActiveSheet.Range("C5").Select
    'put the autofilter back on if it has been removed.
If ActiveSheet.AutoFilterMode = False Then Rows(4).AutoFilter
    'error handle the showalldata part
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...