[英]Opening and Saving new Workbooks - VBA
So I know there have been questions on this before, but none seem to explicitly solve the problems I'm having. 因此,我知道以前对此有疑问,但是似乎没有人明确解决我遇到的问题。 Effectively what I'm trying to do is create a new workbook, copy and paste data into it, and then save that new workbook under a new filename.
实际上,我要尝试做的是创建一个新工作簿,将数据复制并粘贴到其中,然后将该新工作簿保存在新文件名下。 No matter what I do, I seem to get various types of error messages.
无论我做什么,我似乎都会收到各种错误消息。
Here is my code. 这是我的代码。 Any help is very appreciated!
任何帮助都非常感谢!
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
It seems to me that the "New_Name" is causing all my problems, but I'm open to changing anything that will allow this to work. 在我看来,“ New_Name”正在引起我的所有问题,但是我愿意更改任何允许其工作的方法。
Thanks so much! 非常感谢! Zach
扎克
ps I'm relatively new to VBA so please try to keep any explanations somewhat simple! ps我是VBA的新手,所以请尽量使解释简单些!
Try this: 尝试这个:
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
I put this block: 我把这个块:
Else
Set wb = Workbooks(NewFile)
wb.SaveAs Workbooks(CurrentFile).Path & "\" & "New_name.xls"
Exit For
Because every time the condition in your If gives a false response, it will try to save the Workbooks(NewFile) with the same name "New_name.xls" and this will give an error, since the Excel cannot save files with the same name. 因为每当您的If中的条件给出错误的响应时,它都会尝试使用相同的名称“ New_name.xls”保存Workbooks(NewFile),这将产生错误,因为Excel无法保存具有相同名称的文件。
But I'm not sure what you've wanted with this Else condition. 但是我不确定在这种情况下您想要什么。
With your help, I managed to create something that did what I wanted to. 在您的帮助下,我设法创建了自己想要的东西。 Thanks so much!!!
非常感谢!!!
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.