打开和保存新工作簿 - VBA
Posted
技术标签:
【中文标题】打开和保存新工作簿 - VBA【英文标题】:Opening and Saving new Workbooks - VBA 【发布时间】:2017-07-26 14:36:39 【问题描述】:所以我知道以前有过这方面的问题,但似乎没有人能明确解决我遇到的问题。实际上,我要做的是创建一个新工作簿,将数据复制并粘贴到其中,然后以新文件名保存该新工作簿。无论我做什么,我似乎都会收到各种类型的错误消息。
这是我的代码。非常感谢任何帮助!
Private Sub DoStuff()
CurrentFile = "June_Files_macros_new.xlsm"
NewFile = "Train10_June01.xls"
Workbooks.Add
'Save New Workbook
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewFile
For i = 2 To 55
If Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 13) = Cells(i - 1, 13) Then
Workbooks(CurrentFile).Worksheets("Sheet1").Rows(i).Copy _
Workbooks(NewFile).Worksheets("Sheet1").Rows(i)
Else: Workbooks(NewFile).SaveAs ThisWorkbook.Path & "\" & "New_Name"
End If
Next i
End Sub
在我看来,“New_Name”导致了我所有的问题,但我愿意更改任何可以让它工作的东西。
非常感谢! 扎克
ps 我对 VBA 比较陌生,所以请尽量让任何解释保持简单!
【问题讨论】:
您遇到什么错误?如果您点击Debug
是否突出显示Else: ...
行?另外,它是否正确保存为newFile
,而不是"New_Name"
?
【参考方案1】:
试试这个:
Private Sub DoStuff()
Dim CurrentFile As String
Dim NewFile As String
Dim i As Long
Dim wb As Workbook
CurrentFile = "June_Files_macros_new.xlsm"
NewFile = "Train10_June01.xls"
Set wb = Workbooks.Add
wb.SaveAs Workbooks(CurrentFile).Path & "\" & NewFile
For i = 2 To 55
If Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 13) = Cells(i - 1, 13) Then
Workbooks(CurrentFile).Sheets("Sheet1").Rows(i).Copy Workbooks(NewFile).Worksheets("Sheet1").Rows(i)
Else
Set wb = Workbooks(NewFile)
wb.SaveAs Workbooks(CurrentFile).Path & "\" & "New_name.xls"
Exit For
End If
Next i
End Sub
我把这个块:
Else
Set wb = Workbooks(NewFile)
wb.SaveAs Workbooks(CurrentFile).Path & "\" & "New_name.xls"
Exit For
因为每次 If 中的条件给出错误响应时,它都会尝试使用相同的名称“New_name.xls”保存工作簿(NewFile),这会出错,因为 Excel 无法保存带有一样的名字。
但我不确定你想要这个 Else 条件是什么。
【讨论】:
这是对我的脚本的改进......但由于某种原因,它无法复制和粘贴数据。如,我同时打开了 Train10_June1 和 New_name 并且没有任何数据。我知道 for 循环和 if 语句正在工作,因为它们之前正在工作...... 你需要明确你想要什么。在您的代码中,对于“New_name.xls”存档,您的 If-Else 语句不执行任何操作,而是使用新名称保存 Workbooks(NewFile)。如果要复制到两个 Excel 文件,则需要再次检查 If-Else 语句。【参考方案2】:在您的帮助下,我设法创建了一些我想要的东西。 非常感谢!!!
Private Sub DoStuff()
Application.DisplayAlerts = False
'Create New Workbook
Dim Count As Integer
CurrentFile = "June_Files_macros_new.xlsm"
NewFile = "Train" & CStr(Cells(2, 13)) & "_" & CStr(Cells(2, 3)) & ".xls"
Workbooks.Add
'Save New Workbook
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewFile
'Select top row of data and insert into spreadsheed!!!!!
Workbooks(CurrentFile).Worksheets("Sheet1").Rows(2).Copy
Workbooks(NewFile).Worksheets("Sheet1").Rows(2).PasteSpecial xlPasteValues
Count = 3
For i = 3 To 12802
'if Date and Train Number are equal, Then copy and paste the i th row
'else, save new file, create another new file, save
If Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 13) = Cells(i - 1, 13) Then
Workbooks(CurrentFile).Worksheets("Sheet1").Rows(i).Copy
Workbooks(NewFile).Worksheets("Sheet1").Rows(Count).PasteSpecial xlPasteValues
Count = Count + 1
Else: Workbooks(CurrentFile).Worksheets("Sheet1").Rows(1).Copy
Workbooks(NewFile).Worksheets("Sheet1").Rows(1).PasteSpecial xlPasteValues
Workbooks(NewFile).SaveAs ThisWorkbook.Path & "\" & "Train" & CStr(Cells(i - 1, 13)) & "_" & CStr(Cells(i - 1, 3)) & ".xls"
Workbooks(NewFile).Close
Workbooks.Add
NewFile = "Train" & CStr(Cells(i, 13)) & "_" & CStr(Cells(i, 3)) & ".xls"
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewFile
Workbooks(CurrentFile).Worksheets("Sheet1").Rows(i).Copy
Workbooks(NewFile).Worksheets("Sheet1").Rows(2).PasteSpecial xlPasteValues
Count = 3
End If
Next i
Workbooks(CurrentFile).Worksheets("Sheet1").Rows(1).Copy
Workbooks(NewFile).Worksheets("Sheet1").Rows(1).PasteSpecial xlPasteValues
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewFile
Workbooks(NewFile).Close
【讨论】:
以上是关于打开和保存新工作簿 - VBA的主要内容,如果未能解决你的问题,请参考以下文章