打开并保存新工作簿 - VBA

时间:2017-07-26 14:36:40

标签: excel excel-vba for-loop save-as hssfworkbook vba

所以我知道之前有过这方面的问题,但似乎都没有明确解决我遇到的问题。实际上,我正在尝试创建一个新工作簿,将数据复制并粘贴到其中,然后以新文件名保存该新工作簿。无论我做什么,我似乎得到各种类型的错误消息。

这是我的代码。非常感谢任何帮助!

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比较陌生,所以请尽量保持一些简单的解释!

2 个答案:

答案 0 :(得分:0)

试试这个:

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条件你想要什么。

答案 1 :(得分:0)

在你的帮助下,我设法创造了我想要的东西。 非常感谢!!!

create_default_context()