打開和保存新工作簿-VBA

Question

因此，我知道以前對此有疑問，但是似乎沒有人明確解決我遇到的問題。 實際上，我要嘗試做的是創建一個新工作簿，將數據復制並粘貼到其中，然后將該新工作簿保存在新文件名下。 無論我做什么，我似乎都會收到各種錯誤消息。

這是我的代碼。 任何幫助都非常感謝！

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的新手，所以請盡量使解釋簡單些！

Answer 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”保存Workbooks（NewFile），這將產生錯誤，因為Excel無法保存具有相同名稱的文件。

但是我不確定在這種情況下您想要什么。

Answer 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