Question

我有一张工作簿（1）包含2张。在我的程序中，我想生成一个创建2张的工作簿（2）。然后程序将过滤表并将值从工作簿1复制到工作簿2.

但我的问题是我的工作簿（1）名称每次都会改变。我尝试使用ActiveWorkbook.Name。但是当程序运行时，它会创建一个新的工作簿然后突然变成一个活动的工作簿。

我将我的主要工作簿（1）命名为Filevalue。但不行。如何解决这个问题呢。当名称发生变化时，我需要运行此程序。帮帮我

Sub createlandDE()

Filepath = ActiveWorkbook.path
FileValue = ActiveWorkbook.Name 'Problem With Activeworkbook
NameValue = Format(Date, "yymmdd") & "-DE"
Dim wb As Workbook
Set wb = Workbooks.add
Dim path As String
Dim FSO As Object
path = Filepath & "\" & NameValue & ".xlsx"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(path) Then
    On Error Resume Next
        Workbooks(NameValue & ".xlsx").Close False
        Kill path
        wb.SaveAs path
        Sheets(3).Delete
    Else
    wb.SaveAs path
    Sheets(3).Delete
End If
Application.ScreenUpdating = False

Dim ws, ws1, ws2 As Worksheet
Dim table1, table2 As ListObject
Dim rng1 As Range

Sheets(1).Name = "Main view"
Sheets(2).Name = "Overall view"
Set ws1 = Workbooks(NameValue & ".xlsx").Worksheets("Main view")

ws1.ListObjects.add(xlSrcRange, ws1.Range("A$1:$J$1"), , xlYes).Name = "MainTable"
Set table1 = ws1.ListObjects(1)

Set ws = Workbooks(FileValue).Worksheets("Main") 'Problem With Activeworkbook
ws.PivotTables("MainTable").PivotFields("Dealer Country Code").CurrentPage = "DE"

With ws
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set rng1 = Range(.Range("A4"), .Range("J" & LastRow))
End With

rng1.Copy

ws1.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Set ws2 = Sheets("Overall view")

ws2.ListObjects.add(xlSrcRange, ws2.Range("A$1:$Q$1"), , xlYes).Name = "OverallTable"
Set table2 = ws2.ListObjects(1)
Worksheets("Overall view").ListObjects("OverallTable").TableStyle = "Table Style 1"

Workbooks(FileValue).Activate 'Problem With Activeworkbook
Sheet2.ListObjects("DataTable").Range.AutoFilter Field:=1
Sheet2.ListObjects("DataTable").Range.AutoFilter Field:=12
ActiveWorkbook.Save
Application.ScreenUpdating = True

End Sub

当Excel文件名更改时，如何在Excel中运行VBA

0 个答案: