Excel VBA 【001】ファイル複製

同じようなファイルをたくさん作成したい場合に利用して下さい。

複製元ファイルは処理中ダイアログで選択します。
このマクロが存在するブックと同じフォルダに格納してください。

エクセルの表で指定したファイル名に複製(コピー)します。
沢山のファイルを作成する場合に便利です。

以下のような表(シート)を準備してください。
マクロ実行用のボタンをつけてますが、
無くてもよいです。

E001

VBA(マクロ)は以下のようになります。
このマクロを実行すれば指定したファイル名のファイルが複製されます。

Sub E_001()
'--------------------------------------------------------------------
'ファイルを複製する。
'--------------------------------------------------------------------
    Dim fname1 As String
    Dim mypath As String
    Dim ws1 As Worksheet
    Dim c1 As Long
    Dim fd1 As Object
    Set ws1 = ActiveSheet
    '----- コピー元取得 -----
    Set fd1 = Application.FileDialog(msoFileDialogOpen)
    With fd1
        .Title = "複製元ファイルを指定して下さい。"
        .InitialFileName = ThisWorkbook.Path
        .Filters.Clear                              'フィルタをクリア
        .Filters.Add "All File", "*.*", 1
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
    End With
    fname1 = fd1.SelectedItems.Item(1)
    mypath = Left(fname1, InStrRev(fname1, "\"))
    '----- 複製処理 -----
    c1 = 2
    While (ws1.Cells(c1, 1) <> "")
        FileCopy fname1, mypath & ws1.Cells(c1, 1)
        c1 = c1 + 1
    Wend
    c1 = c1 - 2
    If (c1 > 0) Then
        MsgBox (StrConv(c1, vbWide) & "ファイル複製しました。")
    End If
End Sub

自分でVBAを登録できない方は
以下のExcelをダウンロードして使って下さい。
E_001

スポンサーリンク
スポンサーサイト




  • このエントリーをはてなブックマークに追加

スポンサーリンク
スポンサーサイト




コメントをどうぞ

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

CAPTCHA