Question

有人可以在下面提出建议吗？我正在尝试编写代码来将名称中包含 RTP 的工作表从一些工作簿复制到一个工作簿。我得到了下面的代码，但当我尝试运行它时，它基本上崩溃了我的Excel。我将不胜感激，如果这一切都完全错误请告诉我，我会重新开始！

Sub RTP_reporting()
Dim WorkbookName As String
WorkbookName = Format(Date, "dd-mm-yyyy")
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="New RTP report"

Workbooks.Open Filename:="https://addresshere"
ActiveWorkbook.Unprotect Password:="xxx"

Workbooks.Open Filename:="https://addresshere2"
ActiveWorkbook.Unprotect Password:="xxx"

等等，对于9个文件。

Dim ws As Worksheet
 For Each ws In Sheets
  If LCase(ws.Name) Like "*RTP*" Then
        ws.Select
  End If
 Next

Windows("New RTP report.xlsx").Activate
Workbooks("New RTP report.xlsx").Paste
ActiveWorkbook.SaveAs Filename:="RTP_report_" & WorkbookName

然后我想保护以前打开的工作簿并关闭它们。

Windows("File1.xlsm").Activate
ActiveWorkbook.Protect Password:="xxx"
ActiveWindow.Close

Windows("File2.xlsm").Activate
ActiveWorkbook.Protect Password:="xxx"
ActiveWindow.Close

End Sub

Answer 1

我个人不喜欢在我的VBA代码中使用Active...函数和Activate和Select方法，因为它可能导致无法解释的应用程序错误和崩溃。相反，我将我想要使用的对象与变量

一起引用

Dim Report as Workbook
set Report = Workbooks.Add ...
Report.SaveAs ...

对源工作簿执行相同的操作

dim Source as Workbook
set Source = Workbooks.Open ...

现在遍历工作表而不是选择和复制，将工作表直接复制到所需的工作簿

For Each ws in Source.sheets
    If ...
        ws.copy Before:= Report.Sheets(1)
    End If ..
Loop

希望这会指出你正确的方向。

Answer 2

看看这个。

我添加了Workbook对象，以便更轻松地引用引用（Set wb1 = Workbooks.Open("addresshere")）并清理一下代码，这应该可以解决问题！ ;）

Sub RTP_reporting()

Dim WorkbookName As String, _
    wbRep As Workbook, _
    wb1 As Workbook, _
    wb2 As Workbook, _
    ws As Worksheet

WorkbookName = Format(Date, "dd-mm-yyyy")
Set wbRep = Workbooks.Add
wbRep.SaveAs Filename:="New RTP report"

Set wb1 = Workbooks.Open("https://addresshere")
wb1.Unprotect Password:="xxx"

Set wb2 = Workbooks.Open("https://addresshere2")
wb2.Unprotect Password:="xxx"

For Each ws In wb1.Sheets
    If InStr(1, LCase(ws.Name), "rtp") > 0 Then
        ws.Copy after:=wbRep.Sheets(wbRep.Sheets.Count)
    End If
Next
For Each ws In wb2.Sheets
    If InStr(1, LCase(ws.Name), "rtp") > 0 Then
        ws.Copy after:=wbRep.Sheets(wbRep.Sheets.Count)
    End If
Next ws

wbRep.SaveAs Filename:="RTP_report_" & WorkbookName

wb1.Protect Password:="xxx"
wb1.Close
wb2.Protect Password:="xxx"
wb2.Close

Set wbRep = Nothing
Set wb1 = Nothing
Set wb2 = Nothing

End Sub

如果其名称包含特定单词，则将整个选项卡从一个工作簿复制并粘贴到另一个工作簿

2 个答案: