我有一张原始数据，其中包括多天的车辆计数。每个日期都是一行，表示在 60 分钟内(即每天 24 行(内记录的车辆计数。 我有一个模型，它每天使用报告模板创建一个新工作表。我只是无法弄清楚如何获取每天的实际车辆计数数据以填充每小时的每个工作表。 创建的每个新选项卡都以日期命名。如果我们有 8 天的车辆计数，则将创建 8 个新选项卡。在这个新选项卡中，我需要能够获取所有 24 辆车计数并将它们粘贴到相应单元格中的模板报告中。
Option Explicit
Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shDates As Range, Item As Range, NmStr As String
'keep focus in this workbook
With ThisWorkbook
'sheet to be copied
Set wsTEMP = .Sheets("Template")
'check if it's hidden or not
wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)
'make it visible
If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible
'sheet with dates and data
Set wsMASTER = .Sheets("Raw Data")
'range to find names to be checked
Set shDates = wsMASTER.Range("C9:C" & Rows.Count).SpecialCells(xlConstants)
Application.ScreenUpdating = False
'check one data at a time
For Each Item In shDates
NmStr = FixStringForSheetName(CStr(Item.Text))
'if sheet does not exist...
If Not Evaluate("ISREF('" & NmStr & "'!A1)") Then
'...create it from template
wsTEMP.Copy After:=.Sheets(.Sheets.Count)
'...rename it
ActiveSheet.Name = NmStr
End If
Next Item
'return to the master sheet
wsMASTER.Activate
'hide the template if necessary
If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden
'update screen one time at the end
Application.ScreenUpdating = True
End With
MsgBox "All Reports created"
如果不看到工作表(数据的布局/位置(，很难回答，但像下面这样的东西可能会让你了解如何实现你所追求的目标。
Option Explicit
Sub SheetsFromTemplate()
Dim templateSheet As Worksheet
Set templateSheet = ThisWorkbook.Worksheets("Template")
Dim originalSheetState As XlSheetVisibility
originalSheetState = templateSheet.Visible
'sheet with dates and data
Dim masterSheet As Worksheet
Set masterSheet = ThisWorkbook.Worksheets("Raw Data")
templateSheet.Visible = xlSheetVisible
Dim lastRowOnMasterSheet As Long
lastRowOnMasterSheet = masterSheet.Cells(masterSheet.Rows.Count, "C").End(xlUp).Row
Debug.Assert lastRowOnMasterSheet >= 9
'range to find names to be checked
Dim datesToLoopThrough As Range
Set datesToLoopThrough = masterSheet.Range("C9:C" & lastRowOnMasterSheet)
Dim toFilterIncludingHeaders As Range
Set toFilterIncludingHeaders = datesToLoopThrough.Offset(-1).Resize(datesToLoopThrough.Rows.Count + 1)
Application.ScreenUpdating = False
'check one data at a time
Dim item As Range
For Each item In datesToLoopThrough
Dim nmStr As String
nmStr = FixStringForSheetName(CStr(item.Text))
' The IF condition below might be problematic if sheet
' already exists, but has not yet had dates
' transferred/copy-pasted to it.
If Not DoesWorksheetExist(nmStr) Then
With CreateSheetFromTemplate(templateSheet)
.Name = nmStr
.Move After:=.Parent.Worksheets(.Parent.Worksheets.Count)
toFilterIncludingHeaders.AutoFilter Field:=1, Criteria1:=item
Intersect(datesToLoopThrough.SpecialCells(xlCellTypeVisible).EntireRow, mastersheet.range("D:Q")).Copy .Range("F13") ' You haven't shown your template sheet, so don't know where to paste to.
End With
End If
Next item
masterSheet.Activate
templateSheet.Visible = originalSheetState
'update screen one time at the end
Application.ScreenUpdating = True
MsgBox "All Reports created"
End Sub
Private Function CreateSheetFromTemplate(ByVal someTemplateSheet As Worksheet) As Worksheet
' Creates a copy of template sheet and returns an object reference to the newly created sheet.
' Newly created sheet is at index 1 (for deterministic/reliability reasons).
' Call site can name/move as needed.
someTemplateSheet.Copy Before:=someTemplateSheet.Parent.Worksheets(1)
Set CreateSheetFromTemplate = someTemplateSheet.Parent.Worksheets(1)
End Function
Private Function DoesWorksheetExist(ByVal sheetNameToCheck As String) As Boolean
' Checks if sheet of a given name exists in ThisWorkbook.
Dim targetSheet As Worksheet
On Error Resume Next
Set targetSheet = ThisWorkbook.Worksheets(sheetNameToCheck)
On Error GoTo 0
DoesWorksheetExist = Not (targetSheet Is Nothing)
End Function