Question

我编写了一个宏来从一个工作簿中获取选定的工作表，并将这些工作簿复制到另一个工作簿，并以新名称保存。我需要重复运行相同的查询，直到我创建大约6个单独的文件。每个单独的宏工作，我可以一次调用它们，但它们不会按顺序运行。我相信我知道问题在于我编写的代码不会引用回源工作簿，而且我不知道如何编写代码来实现它。

附带的代码是我正在使用的，它可能看起来有点草率 - 我把几个不同的宏放在一起以使其工作。 Gqp Master是正在创建所有其他工作簿的主工作簿的名称。

    Sub Snuth()
'This will prevent the alet from popping up when overwriting graphs, etc
Application.DisplayAlerts = False


Dim FName           As String
Dim FPath           As String
Dim NewBook         As Workbook
Dim strFileName     As String
Dim WS              As Worksheet
Dim WBk             As Workbook

Set WBk = ("Gap Master")

For Each WS In Worksheets
    WS.Visible = True
Next

For Each WS In Worksheets
If WS.Range("C4") <> "Snuth, John" Then
WS.Visible = False
End If

If WS.Range("C4") = "Snuth, John" Then
WS.Visible = True
End If
Next WS


FPath = "C:\Users\mmarshall\Documents\GAP\GAP Development"
FName = "Snuth GAP " & Format(Date, "yyyy-mm-dd") & ".xlsx"

Set NewBook = Workbooks.Add
ThisWorkbook.Sheets.Copy Before:=NewBook.Sheets(1)
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
ActiveWindow.SelectedSheets.Delete

If Dir(FPath & "\" & FName) <> "" Then
    MsgBox "File " & FPath & "\" & FName & " already exists"
Else
    NewBook.SaveAs Filename:=FPath & "\" & FName
End If

  Application.DisplayAlerts = True
 End Sub

Answer 1

试试这个：

你的行后：

NewBook.SaveAs Filename:=FPath & "\" & FName

插入：

NewBook.Close

这会导致您“退回”原始工作簿。

Answer 2

我假设您有其他几个宏，它们或多或少都是完全相同的，只是针对不同的管理器名称。

您可以创建一个将调用其他子/函数的主子例程。这样做是将一些参数/参数发送到子程序，这些是

WBk：您正在从

的工作簿
lastName：经理的姓氏

firstName：经理的名字

以下是代码：

Sub CreateCopies() Dim WBk As Workbook Set WBk = Workbooks("Gap Master") '# Run the CopyForName for each of your manager names, e.g.: CopyForName WBk, "Snuth", "John" CopyForName WBk, "Zemens", "David" CopyForName WBk, "Bonaparte", "Napoleon" CopyForName WBk, "Mozart", "Wolfgang" End Sub

现在，您的子例程的一些修订，以便它足够通用，以执行所有管理器的功能：

Sub CopyForName(wkbkToCopy as Workbook, lastName as String, firstName As String) 'This will prevent the alert from popping up when overwriting graphs, etc Application.DisplayAlerts = False Dim FName As String Dim FPath As String Dim NewBook As Workbook Dim strFileName As String Dim WS As Worksheet FPath = "C:\Users\mmarshall\Documents\GAP\GAP Development" FName = lastName & " GAP " & Format(Date, "yyyy-mm-dd") & ".xlsx" '## I consolidated your 3 loops in to 1 loop For Each WS In wkbkToCopy.Worksheets WS.Visible = (WS.Range("C4") = lastName & ", " & firstname) Next Set NewBook = Workbooks.Add 'Copies sheets from your Gap Master file: wkbkToCopy.Sheets.Copy Before:=NewBook.Sheets(1) '## I think you're trying to delete the default sheets in the NewBook: NewBook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete If Dir(FPath & "\" & FName) <> "" Then MsgBox "File " & FPath & "\" & FName & " already exists" Else NewBook.SaveAs Filename:=FPath & "\" & FName NewBook.Close End If Application.DisplayAlerts = True End Sub

Answer 3

试试这个：

<强>步骤1：变化

Set WBk = ("Gap Master")

要

Set WBk = ActiveWorkbook

第2步： 还添加另一行：

Set NewBook = Workbooks.Add
WBk.Activate '''''add this line''''''
ThisWorkbook.Sheets.Copy Before:=NewBook.Sheets(1)

Answer 4

以下是我提出的内容，将几段不同的代码拼凑在一起：

Sub VPFiles()
Dim WBk             As Workbook
Set WBk = ThisWorkbook

'# Run the CopyForName for each of your manager names, e.g.:
CopyForName WBk, "Doe", "Christopher"
CopyForName WBk, "Smith", "Mark"
CopyForName WBk, "Randall", "Tony"
CopyForName WBk, "Jordan", "Steve"
CopyForName WBk, "Marshall", "Ron"



End Sub

跟着这个：

Sub CopyForName(wkbkToCopy As Workbook, lastName As String, firstName As String)
'This will prevent the alert from popping up when overwriting graphs, etc
Application.DisplayAlerts = False

Dim FName           As String
Dim FPath           As String
Dim NewBook         As Workbook
Dim strFileName     As String
Dim WS              As Worksheet


FPath = "\\filesrv1\department shares\Sales"
FName = lastName & " GAP " & Format(Date, "yyyy-mm-dd") & ".xlsx"

'## I consolidated your 3 loops in to 1 loop
For Each WS In wkbkToCopy.Worksheets
    WS.Visible = (WS.Range("K4") = lastName & ", " & firstName)

Next

Set NewBook = Workbooks.Add


'Copies sheets from your Gap Master file:
wkbkToCopy.Sheets.Copy Before:=NewBook.Sheets(1)

'This delets all unnecessary sheets in the NewBook:
NewBook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
For Each WS In Worksheets
If WS.Visible <> True Then WS.Delete
Next

    NewBook.SaveAs Filename:=FPath & "\" & FName
    NewBook.Close


  Application.DisplayAlerts = True
End Sub

运行多个宏以创建单独的工作簿

4 个答案: