人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

●質問者: mika555
●カテゴリ:コンピュータ インターネット
✍キーワード:エクセル ファイル 作成
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● SALINGER
●35ポイント

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

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


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/

◎質問者からの返答

ありがとうございます。

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


2 ● Mook
●35ポイント ベストアンサー

この手のものは 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

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

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

再実行してください。

◎質問者からの返答

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

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

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


3 ● airplant
●10ポイント

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

次のテキストを該当フォルダに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


4 ● SALINGER
●10ポイント

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

せっかくなので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/

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ