Я ищу помощь VBA, где у меня есть предварительно разработанный структурированный шаблон Excel с 5 вкладками.Одной из вкладок является вкладка «Данные», которая содержит сведения о 10 разделах (названия разделов находятся в столбце А вкладки «Данные»).Остальные все вкладки связаны между собой вкладкой «Данные» и другими вкладками с помощью формул, сводных диаграмм и диаграмм.Я хочу создать код, который будет создавать / копировать этот шаблон с данными отдельных разделов.
Ключевые моменты, на которые следует обратить внимание:
- Код должен использовать тот же шаблон, чтобы поддерживать целостность(формат, защита, диаграммы и т. д.) и связанные формулы на всех вкладках (поэтому может потребоваться использовать функцию save.as)
- Необходимо сохранить главный шаблон
Каждый разделшаблон должен содержать данные только для этого раздела
Любые ссылки будут высоко оценены
Я пробовал код, который помогает создавать несколько рабочих листов, но мне нужно создавать рабочие книги, сохраняяВесь формат мастер-шаблона.
Sub parse_data()
Dim xRCount As Long
Dim xSht As Worksheet
Dim xNSht As Worksheet
Dim I As Long
Dim xTRrow As Integer
Dim xCol As New Collection
Dim xTitle As String
Dim xSUpdate As Boolean
Dim Sht As Worksheet
Dim strPwd As String
Dim strCheck As String
strCheck = "ABC"
strPwd = InputBox("Enter Password", "Password", "")
If strPwd = strCheck Then
For Each xxx In ThisWorkbook.Worksheets
xxx.Unprotect strPwd
Next xxx
Else
MsgBox "Incorrect Password"
End If
'-----------------------------------------------
For Each xSht In Application.ActiveWorkbook.Worksheets
If xSht.Name <> "Index" And xSht.Name <> "Combine" And xSht.Name <> "Long Position Current Month" And xSht.Name <> "Long Position Prior Month" Then
Application.DisplayAlerts = False
xSht.Delete
End If
Next
Worksheets("Long Position Current Month").Activate
Set xSht = ActiveSheet
On Error Resume Next
xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
xTitle = "A1:CZ1"
xTRrow = xSht.Range(xTitle).Cells(1).Row
For I = 3 To xRCount
Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
Next
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCol.Count
Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
Set xNSht = Nothing
Set xNSht = Worksheets(CStr(xCol.Item(I)))
If xNSht Is Nothing Then
Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I))
Else
xNSht.Move , Sheets(Sheets.Count)
End If
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
xNSht.Range("2:2").Select
Selection.AutoFilter
xNSht.AutoFilter = True
xNSht.AutoFilterMode = True
xNSht.Range("A3:AA50000").Select
Selection.Locked = False
Selection.FormulaHidden = False
xNSht.Range("A3").Select
ActiveWindow.FreezePanes = True
xNSht.Protect Password:="ABC", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next
xSht.AutoFilterMode = True
xSht.AutoFilter.ShowAllData
'Sheets(Array("Combine", "Long Positions")).Select
'ActiveWindow.SelectedSheets.Visible = False
xSht.Activate
Application.ScreenUpdating = xSUpdate
End Sub
С 10 уникальными значениями в данном столбце - 10 шаблонов создаются только с данными для соответствующих значений.