打开和保存新工作簿-VBA [英] 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

在我看来，"New_Name"正在引起我的所有问题，但是我愿意改变任何可以使它起作用的方法.

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.

非常感谢！ 扎克

ps我对VBA还是比较陌生，所以请尽量保持任何简单解释！

ps I'm relatively new to VBA so please try to keep any explanations somewhat simple!

推荐答案

在您的帮助下，我设法创建了一些我想要做的东西. 非常感谢！！！

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

这篇关于打开和保存新工作簿-VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！