Question

我有下面显示的代码，允许我将工作簿的副本保存为XLSX文件，每次运行代码时文件名都不同。该代码可以使用正确的名称正确保存文件。但是，当涉及到它应该复制并粘贴新文件中的数据作为值的部分时，它不会对新文件执行，而只是原始文件。我的目标是获得原始文件的副本，其中没有任何宏或查询。

有人可以帮助为代码创建一种方法来实现它需要在新文件中进行复制和粘贴吗？

Sub Macro1()
Dim PathName As String
Dim FileName As String
Dim AWorkbook As String
AWorkbook = "Operational Dashboard Worksheet"
PathName = Sheet4.Range("B7").Value
FileName = Sheet4.Range("B5").Value

Workbooks(AWorkbook).Save
Workbooks(AWorkbook).Sheets(Array("Dashboard", "Extra Details", "Worksheet", "Occupancy", "Shrinkage", _
    "SL Impact", "VBA Codes")).Copy
ActiveWorkbook.SaveAs PathName & FileName & ".xlsx", FileFormat:=51

Workbooks(FileName).Activate
Sheet2.Range("Q:AD").Copy
Workbooks(FileName).Activate
Sheet2.Range("Q:AD").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(FileName).Activate
Sheet3.Range("B:AI").Copy
Workbooks(FileName).Activate
Sheet3.Range("B:AI").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(FileName).Activate
Sheet7.Range("N:AQ").Copy
Workbooks(FileName).Activate
Sheet7.Range("N:AQ").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(FileName).Activate
Sheet5.Range("A:G").Copy
Workbooks(FileName).Activate
Sheet5.Range("A:G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(FileName).Activate
Sheet5.Range("AB:AS").Copy
Workbooks(FileName).Activate
Sheet5.Range("AB:AS").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(FileName).Activate
Sheet5.Range("AX:CQ").Copy
Workbooks(FileName).Activate
Sheet5.Range("AX:CQ").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Workbooks(AWorkbook).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False

End Sub

Answer 1

使用Worksheet.Activate可以正常工作，但是来回交换会让人感到困惑。创建对源和目标工作簿和工作表的引用可以更容易（imo）跟踪事物，并且它还可以加快速度，因为您只处理数据而不是gui。

' eg
Dim SourceBook As Wokbook
Set SourceBook = ThisWorkbook

我认为您的问题可能是在代码中使用SheetN.Range来复制数据。对于数据，SheetN可能会查找ThisWorkbook而不是ActiveWorkbook。所以你正在为原始工作簿做些什么。

我的代码中使用的工作表索引可能与您的原始代码不匹配。您可以将索引Sheets(Index)替换为您尝试复制数据的工作表的名称。

Sub Macro1()
Dim PathName As String
Dim FileName As String
Dim AWorkbook As String
AWorkbook = "Operational Dashboard Worksheet"
PathName = Sheet4.Range("B7").Value
FileName = Sheet4.Range("B5").Value

Workbooks(AWorkbook).Save
Workbooks(AWorkbook).Sheets(Array("Dashboard", "Extra Details", "Worksheet", "Occupancy", "Shrinkage", _
    "SL Impact", "VBA Codes")).Copy
ActiveWorkbook.SaveAs PathName & FileName & ".xlsx", FileFormat:=51

Dim Book As Workbook
Set Book = Workbooks(FileName)

Book.Sheets(2).Range("Q:AD").Copy
Book.Sheets(2).Range("Q:AD").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Book.Sheets(3).Range("B:AI").Copy
Book.Sheets(3).Range("B:AI").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Book.Sheets(7).Range("N:AQ").Copy
Book.Sheets(7).Range("N:AQ").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Book.Sheets(5).Range("A:G").Copy
Book.Sheets(5).Range("A:G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Book.Sheets(5).Range("AB:AS").Copy
Book.Sheets(5).Range("AB:AS").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Book.Sheets(5).Range("AX:CQ").Copy
Book.Sheets(5).Range("AX:CQ").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Book.Save

Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False

End Sub

<强>更新

我并没有真正使用SheetN（代码名称），所以我的理解并不完全正确。它是在工作表的VBA编辑器中定义的名称，使用时直接引用工作表。（您也可以在VBA编辑器中编辑它们，以便Sheet1-＆gt; Dashboard？）

经过测试后，似乎当您在代码中使用Workbooks(..).Worksheets(...).Copy时，我也会将这些名称复制到新工作簿中。这很好，但您无法直接引用其他工作簿中的代码名称。下面是我的代码的修改版本，它使用我找到的一些代码间接引用它们。（未经测试且不太漂亮）

Sub Macro1()
Dim PathName As String
Dim FileName As String
Dim AWorkbook As String
AWorkbook = "Operational Dashboard Worksheet"
PathName = Sheet4.Range("B7").Value
FileName = Sheet4.Range("B5").Value


Workbooks(AWorkbook).Save
Workbooks(AWorkbook).Sheets(Array("Dashboard", "Extra Details", "Worksheet", "Occupancy", "Shrinkage", _
    "SL Impact", "VBA Codes")).Copy
ActiveWorkbook.SaveAs PathName & FileName & ".xlsx", FileFormat:=51

Dim Book As Workbook
Set Book = Workbooks(FileName)

Dim Sheet2N As Worksheet
Set Sheet2N = GetWsFromCodeName(Book, "Sheet2")
Dim Sheet3N As Worksheet
Set Sheet3N = GetWsFromCodeName(Book, "Sheet3")
Dim Sheet5N As Worksheet
Set Sheet5N = GetWsFromCodeName(Book, "Sheet4")
Dim Sheet7N As Worksheet
Set Sheet7N = GetWsFromCodeName(Book, "Sheet7")

Sheet2N.Range("Q:AD").Copy
Sheet2N.Range("Q:AD").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet3N.Range("B:AI").Copy
Sheet3N.Range("B:AI").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet7N.Range("N:AQ").Copy
Sheet7N.Range("N:AQ").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet5N.Range("A:G").Copy
Sheet5N.Range("A:G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet5N.Range("AB:AS").Copy
Sheet5N.Range("AB:AS").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet5N.Range("AX:CQ").Copy
Sheet5N.Range("AX:CQ").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Book.Save

Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False

End Sub

'http://yoursumbuddy.com/using-worksheet-codenames-in-other-workbooks/
Function GetWsFromCodeName(wb As Workbook, CodeName As String) As Excel.Worksheet
Dim ws As Excel.Worksheet

For Each ws In wb.Worksheets
    If ws.CodeName = CodeName Then
        Set GetWsFromCodeName = ws
        Exit For
    End If
Next ws
End Function

Answer 2

我还没有对此进行全面测试，但是当我在Instant Pane中尝试执行Workbooks("Stores").Activate时，当我知道Stores处于打开状态时会抛出运行时错误“9”：下标超出范围错误。

如果我添加文件扩展名Workbooks("Stores.xlsx").Activate，则可以正常工作，执行?ActiveWorkbook.Name会返回Stores.xlsx。

所以你的：

Workbooks(FileName).Activate

应该是：

Workbooks(FileName & ".xlsx").Activate

或者您可以在定义FileName时添加扩展名：

FileName = Sheet4.Range("B5").Value & "xlsx"

那就是说，你很少需要在VBA中Activate任何东西。例如：

Workbooks(FileName).Activate
Sheet2.Range("Q:AD").Copy
Workbooks(FileName).Activate
Sheet2.Range("Q:AD").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

可以替换为：

Workbooks(FileName).Sheet2.Range("Q:AD").Copy
Workbooks(FileName).Sheet2.Range("Q:AD").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

VBA代码不是在正确的工作簿中复制和粘贴

2 个答案: