次の行を置き換えるのではなく、次の行に保存する方法

Question

VBAを使用してExcelフォームの値を別のブックに取り込もうとしましたが、これは私が使用しているVBAコードです：

Sub RunMe() 
    Dim lRow, lCol As Integer 

    Sheets("Sheet1").Select 
    lRow = Range("A" & Rows.Count).End(xlUp).Row 
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column 

    For Each cell In Range(Cells(1, "B"), Cells(1, lCol)) 
     Union(Range("A1:A" & lRow), Range(Cells(1, cell.Column), Cells(lRow, cell.Column))).Copy 
     Workbooks.Add 
     Range("A1").PasteSpecial 
     ActiveWorkbook.SaveAs Filename:= _ 
      "C:\Users\john\Desktop\Testforvba" & cell.Value & ".xls" 
     ActiveWorkbook.Close 
    Next cell 

    Application.CutCopyMode = False 
End Sub 

しかし、事は、私は、フォーム上のサンプル値を入力した後にこのコードを実行すると、手動でマクロを実行すると、それは新しいファイルを作成し、サンプルデータを保存するように私が上で入力した作品ということですフォームワークブック。 しかし、マクロを再実行しようとすると、以前のすべてのデータを置き換えることを意味するファイルAGAINが再作成されることに気付きました。 VBAはとても勇気があります。誰でも手に感謝してください。

PS私は私の個人的なワークブック

Answer 1

に保存されたマクロは、このいずれかを試してみてください：

Option Explicit 

Sub RunMe() 
    Application.ScreenUpdating = False 
    Dim lRow As Long, lCol As Long 

    Dim wb As Workbook, wbNew as Workbook 
    Dim ws As Worksheet, wsNew as Worksheet 
    Set wb = ThisWorkbook 
    Set ws = wb.Sheets("Sheet1") 

    lRow = ws.Range("A" & Rows.Count).End(xlUp).Row 
    lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column 

    Dim cell As Variant 
    For Each cell In ws.Range(ws.Cells(1, "B"), ws.Cells(1, lCol)) 
     Union(ws.Range("A1:A" & lRow), ws.Range(ws.Cells(1, cell.Column), ws.Cells(lRow, cell.Column))).Copy 
     Set wbNew = Workbooks.Add 
     Set wsNew = wbNew.Sheets("Sheet1") 
     Dim yourdesktopaddress As String 
     yourdesktopaddress = CreateObject("WScript.Shell").specialfolders("Desktop") & "\Testforvba" 
     wsNew.Range("A1").PasteSpecial 
    If Not Dir(yourdesktopaddress & "\" & cell.Value & ".xls", vbDirectory) = vbNullString Then 
     'MsgBox "exists" 
     Application.DisplayAlerts = False 
    Else 
     Application.DisplayAlerts = False 
     ActiveWorkbook.SaveAs Filename:= _ 
     yourdesktopaddress & "\" & cell.Value & ".xls" 
    End If 

    wbNew.Close 
    Application.DisplayAlerts = True   
    Next cell 

    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 
    End Sub 

主な問題は、マクロを実行すると、Excelがゼロからファイルを作成していたし、これがにExcelを引き起こしていた時はいつでも、でした各ファイルを再作成してください。私はこのファイルがすでに作成されているかどうかを確認するために私のコードのIf Not Dir(yourdesktopaddress & "\Testforvba" & cell.Value & ".xls", vbDirectory) = vbNullStringの部分を追加しました。そうでなければ、ファイルを作成しています。 "'"を'MsgBox "exists"の先頭から削除すると、このファイルはすでに存在していると常に通知されます。変数の場合また

が明確に定義されていない、Excelは、それ自体を上書きし始めるかもしれない、それは前のデータを交換することができます。 （特にRange("A1).PasteSpecialとのような重要な点が最も重要な点です）だから、すべての変数を定義した全コードを編集して、ユーザーのデスクトップアドレスを定義して、すべてのユーザーにコードが動作するようにしてください。