excel 打开和保存新工作簿- VBA

oalqel3c 于 2022-11-18 发布在其他

关注(0)|答案(2)|浏览(275)

我知道以前有人对此提出过问题，但似乎没有一个能明确解决我遇到的问题。实际上，我尝试做的是创建一个新工作簿，将数据复制并粘贴到其中，然后以新文件名保存新工作簿。无论我做什么，似乎都收到各种类型的错误消息。
这是我的代码。任何帮助都非常感谢！

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比较陌生，所以请尽量使任何解释简单一些！

excel

来源：https://stackoverflow.com/questions/45330104/opening-and-saving-new-workbooks-vba

2条答案

按热度按时间

7lrncoxx1#

试试看：

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中的条件给出false响应时，它都将尝试以相同的名称“New_name. xls”保存工作簿（NewFile），这将产生错误，因为Excel无法以相同的名称保存文件。
但我不确定您想要这个Else条件做什么。

赞(0）回复(0）举报 2022-11-18

qc6wkl3g2#

在你的帮助下，我设法创造了一些我想做的事情。非常感谢！！！

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

赞(0）回复(0）举报 2022-11-18

我来回答

excel 打开和保存新工作簿- VBA

2条答案

相关问题

热门标签

最新问答