创build新的工作表(如果不存在),基于单元格值进行重命名,然后引用该工作表

我有两个工作簿之一的vba(MainWb),另一个只是一个模板(TempWb)的代码粘贴值和公式从mainworkbook。 TempWb只有一个名为图表的空白表。 代码需要打开xltx文件(TempWb),添加工作表并根据MainWb上的某个单元格中的值重命名(如果尚不存在),然后在MainWb的副本值过程中引用该新工作表。 我试图录制一个macros,但它并没有真正的帮助。 我已经研究和把一些东西放在一起,但不知道它是否适合工作。 任何build议,将不胜感激。

这是我迄今为止。

Option Explicit Sub ExportSave() Dim Alpha As Workbook 'Template Dim Omega As Worksheet 'Template Dim wbMain As Workbook 'Main Export file Dim FileTL As String 'Test location Dim FilePath As String 'File save path Dim FileProject As String 'Project information Dim FileTimeDate As String 'Export Date and Time Dim FileD As String 'Drawing Number Dim FileCopyPath As String 'FileCopy save path Dim FPATH As String 'File Search Path Dim Extract As Workbook 'File Extract Data Dim locs, loc 'Location Search Dim intLast As Long 'EmptyCell Search Dim intNext As Long 'EmptyCell Seach Dim rngDest As Range 'Paste Value Range Dim Shtname1 As String 'Part Platform Dim Shtname2 As String 'Part Drawing Number Dim Shtname3 As String 'Part Info Dim rep As Long With Range("H30000") .Value = Format(Now, "mmm-dd-yy hh-mm-ss AM/PM") End With FilePath = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test" FileCopyPath = "C:\Users\aholiday\Desktop\Backup" FileTL = Sheets("Sheet1").Range("A1").Text FileProject = Sheets("Sheet1").Range("E2").Text FileTimeDate = Sheets("Sheet1").Range("H30000").Text FileD = Sheets("Sheet1").Range("E3").Text FPATH = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\" Shtname1 = wbMain.Sheets("Sheet1").Range("E2") Shtname2 = wbMain.Sheets("Sheet1").Range("E3") Shtname3 = wbMain.Sheets("Sheet1").Range("E4") Select Case Range("A1").Value Case "Single Test Location" Case "Location 1" Application.DisplayAlerts = False Set wbMain = Workbooks("FRF Data Export Graphs.xlsm") wbMain.Sheets("Sheet1").Copy ActiveWorkbook.SaveAs Filename:=FileCopyPath & "\" & FileProject & Space(1) & FileD & Space(1) & FileTL & Space(1) & FileTimeDate & ".xlsx", FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close False Set Alpha = Workbooks.Open("\\plymshare01\Public\Holiday\FRF Projects\Templates\FRF Data Graphs.xltx") For rep = 1 To (Worksheets.Count) If LCase(Sheets(rep)).Name = LCase(Shtname1 & Space(1) & Shtname2 & Space(1) & Shtname3) Then MsgBox "This Sheet already exists" Exit Sub End If Next Sheets.Add after:=Sheets(Sheets.Count) Sheets(ActiveSheet.Name).Name = Shtname1 & Space(1) & Shtname2 & Space(1) & Shtname3 Set Omega = Workbooks(ActiveWorkbook.Name).Sheets("ActiveWorksheet.Name") locs = Array("FRF Data Export Graphs.xlsm") 'set the first data block destination Set rngDest = Omega.Cells(3, 1).Resize(30000, 3) For Each loc In locs Set Extract = Workbooks.Open(Filename:=FPATH & loc, ReadOnly:=True) rngDest.Value = Extract.Sheets("Sheet1").Range("A4:D25602").Value Extract.Close False Set rngDest = rngDest.Offset(0, 4) 'move over to the right 4 cols Next loc With ActiveWorksheet.Range("D3:D25603").Formula = "=SQRT((B3)^2+(C3)^2)" ActiveWorkbook.Charts.Add ActiveChart.ChartType = xlXYScatterLines ActiveChart.SetSourceData Source:=Sheets("Graphs").Range("A3:D7"), PlotBy:=xlRows ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Shtname2 With ActiveChart .HasTitle = True .ChartTitle.Characters.Text = Shtname2 .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Hz" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Blank" End With Application.ScreenUpdating = True Case "Location 2" Case "Location 3" Case "Location 4" Case Else MsgBox "Export Failed!" End Select Application.DisplayAlerts = True End Sub 

运行时错误'91'对象variables或With块没有设置代码行

 Shtname1 = wbMain.Sheets("Sheet1").Range("E2") Shtname2 = wbMain.Sheets("Sheet1").Range("E3") Shtname3 = wbMain.Sheets("Sheet1").Range("E4") 

这应该告诉代码什么来命名新创build的工作表

修正:移动下

 Set = wbMain = Workbooks("FRF Data Export Graphs.xlsm") 

新错误:对象不支持此属性或方法代码

  If LCase(Sheets(rep)).Name = LCase(Shtname1 & Space(1) & Shtname2 & Space(1) & Shtname3) Then 

这里可能会发生一些事情

 Shtname1 = wbMain.Sheets("Sheet1").Range("E2") 

您正尝试访问三个对象并设置第三个对象。 这意味着需要设置wbMain需要设置Sheets("Sheet1")Range("E2")

你也是,因为你将Shtname1设置为一个string,我会明确你想要在那里的值。

 Shtname1 = wbMain.Sheets("Sheet1").Range("E2").Value 

因此,在该行的断点和本地窗口打开(视图>本地窗口),确保一切都设置。 如果不是,那就需要。 其中一个价值观没有设定。

如果你确实Set wbMain = Workbooks("FRF Data Export Graphs.xlsm")但是它位于不同的模块或者不同的子模块中,并且在这个子模块的顶部重新声明了wbMain ,这些语句在完全不同的上下文中。 第一个wbMain基本上是一个不同的variables。