私の質問

Question

リストによると、リストからExcelテンプレートファイルのコピーを作成し、名前の変更：マクロiは2つのExcelファイルを持っている

を必要とし、最初は「すべてのジョブ＃のリストが含まれているマスターファイルでありますs。 2番目のファイルは数式を含むテンプレートです。

まず、Excelファイルのようになります。第二のファイルは、私が欲しいものの仕事とその詳細

を調べテンプレートが作成コードである

ColumnA

Job# 1 
Job# 2 
Job# 3 
Job# 4 

テンプレートのコピーですが、私はジョブ＃1、ジョブ＃2などと名前を変更したい各ジョブのファイルをExcelします。特定のフォルダに保存します。

トリッキーな部分は、ファイルがすでに存在する場合は上書きしたくないということです。

これは可能ですか？もしあれば、どんな助けもありがとう。

は

Answer 1

このコードを試してみてください、ありがとうございました。それは少し荒く、テストされていませんが、仕事をする必要があります。 Masterworkブックはテンプレートと同じディレクトリに置く必要があります。

Option Explicit 

Sub CopyData() 
Dim wksCurrent As Worksheet, wkbNew As Workbook 
Dim rng As Range, c As Range, LastCell As Range 
Dim wkbPath As String, wkbFileName As String, LFilename As String, wkbNewPath As String 
Dim i As Integer 
Dim lrow As Long, LastRowInput As Long 

Application.ScreenUpdating = False 

Set wksCurrent = ThisWorkbook.Sheets("Sheet1") 

Set rng = Selection 

On Error GoTo errHandler 

wkbPath = ActiveWorkbook.Path & "\" 
wkbNewPath = wkbPath & "JobTemplate.xlsx" 

Set wkbNew = Workbooks.Open(wkbNewPath) 

LastRowInput = wksCurrent.Cells(Rows.Count, "A").End(xlUp).Row 

' If nothing is selected in column A 
' GoTo Error Handling 
If rng.Cells(1, 1) Is Nothing Then 
GoTo errHandler 
End If 

For Each c In rng.Cells 
lrow = wkbNew.Worksheets(1).Range("B1").Offset(wkbNew.Worksheets(1).Rows.Count - 1, 0).End(xlUp).Row 

    wksCurrent.Range("A" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("B" & lrow) 
Next 

Application.ScreenUpdating = True 

' Error Handling 
exitHandler: 

LFilename = wkbPath & wkbNew.Worksheets(1).Range("B" & lrow) & ".xlsx" 
If Dir(LFilename) <> "" Then 
    ChDir (wkbNewPath) 'To open in folder 
    LFilename = Application.GetSaveAsFilename(InitialFileName:="", FileFilter:="Excel Files (*.xls), *.xls") 
End If 

If (LFilename <> "" And LFilename <> "False") Then 
    ActiveWorkbook.SaveAs LFilename 
Else 
    'filename is still empty - user may have cancelled GetSaveAsFilename Dialog 
    'do something to handle this possibility... 
    MsgBox "file was not saved!" 
End If 
Exit Sub 
errHandler: 
MsgBox "Please select cell(s) in column A", vbCritical, "Error" 
Exit Sub 
End Sub