新しいワークブックを開いて保存する - 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 

あなたの場合では毎回、条件が偽の応答を与えるので、それはと（NEWFILE）ブックを保存しようとしますExcelが同じ名前のファイルを保存することはできないため、同じ名前の "New_name.xls"とエラーが発生します。

しかし、私はあなたがこのElse条件で何を求めているのか分かりません。

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