エクセルで同じファイルの複製を同時にファイル名を変えて作成する方法があったら教えてください。1ファイルから400ファイル同時とかです。よろしくお願いいたします。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2009/04/22 12:04:16
  • 終了:2009/04/23 11:54:59

ベストアンサー

id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912009/04/22 17:43:55

ポイント35pt

この手のものは EXCEL を介さずに直接処理したほうが早いです。


下記の手順で試してみてください。

(1) 任意のフォルダで、右クリックから「新規作成」⇒「テキストドキュメント」をクリックし

  「CopyFile.vbs」としてする(警告が出ますが「はい」を押してください)。

(2)CopyFile.vbs を右クリックし、「編集」を選択する。

(3)開いたウィンドウに下記のコードをコピーし、「ファイル」⇒「上書き」をし、閉じる。

(4)コピーしたいファイルをCopyFile.vbs にドラッグ&ドロップする。

(5)コピー数を聞かれるのでコピーしたい数を指定する。

以上で、同じフォルダ内に数値をつけたファイルがし定数コピーされます。

ファイル名を数字以外で作成したい場合は、どのようなファイルにしたいかコメントください。


If WScript.Arguments.Count = 0 Then WScript.Quit

Dim fso
Set fso = CreateObject( "Scripting.FileSystemObject" )

'--- コピー元ファイルの確認
filePath = WScript.Arguments.Item(0)
If fso.FileExists( filePath ) = False Then
    WScript.Echo filePath  & "がありません"
    WScript.Quit
End If

'--- コピー数の指定
Num = InputBox(  filePath &  vbNewLine & "をいくつコピーしますか")
If IsNumeric( Num ) = False Then
    WScript.Echo "数値を入力してください。"
    WScript.Quit
End If

If Num > 999 Or Num < 1 Then
    WScript.Echo "数値は1~999で指定してください。"
    WScript.Quit
End If


Extention = "." & fso.GetExtensionName( filePath )

'--- ファイルチェック
For i=1 To Num
    newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention )
    If fso.FileExists( newFilePath ) = True Then
        WScript.Echo "作成予定のファイル【" &  newFilePath & "】が既に存在します。"
        WScript.Quit
    End If
Next

'--- ファイルコピー
For i=1 To Num
    newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention )
    fso.CopyFile filePath, newFilePath
Next

http://pawafuru.hiho.jp/hiyo-7.html

(注)同じファイルを繰り返しコピーする場合、コピーする名前(数字が付いた名前)が既にあると

処理を中断するので、いったんコピーでできたファイルを削除か他のフォルダへ移動してから

再実行してください。

id:mika555

いつもありがとうございます。

ファイルは規則性があるようですがその規則が不定なので

ファイル名はCSV等で一覧表を作り、コピー変更しようと思っています。

2009/04/23 11:53:54

その他の回答(3件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/04/22 12:55:36

ポイント35pt

たぶん、ファイルシステムオブジェクトとかでファイルのコピーをした方が処理が早いのでしょうが、

単純に同じ場所に連番をつけて名前を付けて保存するマクロです。


Sub test()
    Dim i As Integer
    Dim str As String
    str = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    For i = 1 To 400
        ThisWorkbook.SaveAs str & i & ".xls"
    Next
End Sub

http://q.hatena.ne.jp/

id:mika555

ありがとうございます。

マクロはコピーされない方法があったら教えて下さい。

2009/04/22 15:04:44
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912009/04/22 17:43:55ここでベストアンサー

ポイント35pt

この手のものは EXCEL を介さずに直接処理したほうが早いです。


下記の手順で試してみてください。

(1) 任意のフォルダで、右クリックから「新規作成」⇒「テキストドキュメント」をクリックし

  「CopyFile.vbs」としてする(警告が出ますが「はい」を押してください)。

(2)CopyFile.vbs を右クリックし、「編集」を選択する。

(3)開いたウィンドウに下記のコードをコピーし、「ファイル」⇒「上書き」をし、閉じる。

(4)コピーしたいファイルをCopyFile.vbs にドラッグ&ドロップする。

(5)コピー数を聞かれるのでコピーしたい数を指定する。

以上で、同じフォルダ内に数値をつけたファイルがし定数コピーされます。

ファイル名を数字以外で作成したい場合は、どのようなファイルにしたいかコメントください。


If WScript.Arguments.Count = 0 Then WScript.Quit

Dim fso
Set fso = CreateObject( "Scripting.FileSystemObject" )

'--- コピー元ファイルの確認
filePath = WScript.Arguments.Item(0)
If fso.FileExists( filePath ) = False Then
    WScript.Echo filePath  & "がありません"
    WScript.Quit
End If

'--- コピー数の指定
Num = InputBox(  filePath &  vbNewLine & "をいくつコピーしますか")
If IsNumeric( Num ) = False Then
    WScript.Echo "数値を入力してください。"
    WScript.Quit
End If

If Num > 999 Or Num < 1 Then
    WScript.Echo "数値は1~999で指定してください。"
    WScript.Quit
End If


Extention = "." & fso.GetExtensionName( filePath )

'--- ファイルチェック
For i=1 To Num
    newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention )
    If fso.FileExists( newFilePath ) = True Then
        WScript.Echo "作成予定のファイル【" &  newFilePath & "】が既に存在します。"
        WScript.Quit
    End If
Next

'--- ファイルコピー
For i=1 To Num
    newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention )
    fso.CopyFile filePath, newFilePath
Next

http://pawafuru.hiho.jp/hiyo-7.html

(注)同じファイルを繰り返しコピーする場合、コピーする名前(数字が付いた名前)が既にあると

処理を中断するので、いったんコピーでできたファイルを削除か他のフォルダへ移動してから

再実行してください。

id:mika555

いつもありがとうございます。

ファイルは規則性があるようですがその規則が不定なので

ファイル名はCSV等で一覧表を作り、コピー変更しようと思っています。

2009/04/23 11:53:54
id:airplant No.3

airplant回答回数220ベストアンサー獲得回数492009/04/23 01:09:46

ポイント10pt

ファイルを別名でコピーしたいだけであれば、バッチファイルが簡単です。

次のテキストを該当フォルダにDupExcel.batのように保存して動かしてみてください。

●コピー先ファイル名をテキストファイルにリストアップしておく場合

hoge.xls:コピー元Excelファイル

duplist.txt:コピー先ファイル名を改行で区切ったリスト(.xlsなしで考えました)

for /F %%E in (duplist.txt) do copy hoge.xls %%E.xls

●コピー先ファイル名が連番でいい場合

set a=1
:loop
	if %a%==11 goto :EOF
	copy hoge.xls NewHoge%a%.xls
	set /a a=%a%+1
goto loop

URL必須のようなので、バッチの基本のサイトです。

http://ykr414.com/dos/dos05.html

id:SALINGER No.4

SALINGER回答回数3454ベストアンサー獲得回数9692009/04/22 15:29:58

ポイント10pt

ファイルを連番をつけてコピーするツールならば、いろいろありそうですが、

せっかくなのでVBAでファイルの保存ではなく、コピーするサンプルにしてみました。

マクロをコピーさせない場合は、コピーするブック以外のブックから実行すればいいです。

実行するとコピーするブックを選択するダイアログが出ますので、その場所に400個連番をつけてコピーします。


Sub test()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim OpenFileName As String
    Dim i As Integer
    
    OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
    If OpenFileName = "False" Then Exit Sub
    
    For i = 1 To 400
        FSO.CopyFile OpenFileName, Left(OpenFileName, Len(OpenFileName) - 4) & i & ".xls"
    Next
    
    Set FSO = Nothing
End Sub

http://q.hatena.ne.jp/

  • id:airplant
    要望のことはコマンドプロンプトのfor文1行でできます(今から未読をオープンします)。
    ファイル名リストは、適当なファイルにメモ帳で作っておけば大丈夫です。
    コメントでは伝わらないかも知れないので、別手段で連絡しておきます。
  • id:Mook
    蛇足ですが、バッチの場合ファイル名にスペースがあると対応が必要なので、
    その場合は下記のような対応が必要ですね。

    for /F "delims=" %%E in (duplist.txt) do copy "hoge.xls" "%%E.xls"

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません