[[20100923200934]]　『コピーファイル名にセルの値』（でこ）　ページの最後に飛ぶ

『コピーファイル名にセルの値』（でこ）

 基準となるファイルをコピーして100人分のファイルを作成したいと思い、
 検索した結果、こちらを参考にさせて頂こうと思いました。

[[20100125092426]]　『セルの値をブック名、８０人分』（ひろ）

 (すみません、リンクの貼り方がわかりません…）
 コピーしたファイルの各Sheet1のE3セルにファイル名にしたのと同じ値を
 転記したいので、下記のように変更しました。
 実際の保存先は下記とは違いますので、そこは修正して試しました。
 結果、Copy masterPath, dstpathのところでコンパイルエラー　Subまたは
 functionが定義されていませんというエラーになりました。

 新規作成したファイルのSheet1のA1セルからA100セルにファイル名にしたい値を
 入力して作業ファイルとしてコピー先フォルダに保存、このファイルにマクロを
 作成しているのですが、これであっているでしょうか？
 またエラーに対してどこを修正すればいいのか教えて下さい。
 よろしくお願いします。

 Sub BookCopy()
    Const masterPath = "C:\Data\Master.xls" '★コピー元ファイルを指定
    Const dataFolder = "C:\Data\"           '★コピー先フォルダを指定

    For i = 1 To 100
        dstpath = dataFolder & Cells(i, "A").Value & ".xls"
        Copy masterPath, dstpath
        With Workbooks.Open(dstpath)
            .Worksheets(1).Range("E3") = ThisWorkbook.Worksheets(1).Cells(i, "A").Value
            .Save
            .Close
        End With
    Next
 End Sub

Excel2000

 こんばんは
        FileCopy masterPath, dstpath
 とするとどうですか？
（ウッシ）

 ウッシ様へ
 下記の箇所が黄色になってデバッグします。
        FileCopy masterPath, dstpath
 なんとかなりませんか
 よろしくご指導ください。
 (かんな)

 こんにちは
 エラーメッセージに変化は無いですか？
 （ウッシ）

 CreateObject("Scripting.FileSystemObject").CopyFile _
              "コピー元ファイルフルパス", "コピー先ファイルフルパス", True

 ヘルプより

 FileCopy ステートメント
 ファイルをコピーします。

 構文
 FileCopy source, destination
 FileCopy ステートメントの構文は、次の名前付き引数から構成されます。

 指定項目 内容 
 source 必ず指定します。コピーするファイル名を示す文字列式を指定します。
 フォルダ名およびドライブ名を含めて指定できます。 
 destination 必ず指定します。コピー後のファイル名を示す文字列式を指定します。
 フォルダ名およびドライブ名を含めて指定できます。

 解説　　　　　　↓これじゃない？
 既に開いているファイルに対して、FileCopy ステートメントを実行しようとすると、エラーが発生します。
 BJ

 こんにちは
 開いてるファイルならばエラーメッセージも変わってるはずですね。
 "C:\Data\Master.xls" が開かれてる・・・このマクロが設定されたブックなら
 Sub BookCopy()
    Const masterPath = "C:\Data\Master.xls" '★コピー元ファイルを指定
    Const dataFolder = "C:\Data\"           '★コピー先フォルダを指定

    ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
    For i = 1 To 100
        dstpath = dataFolder & Cells(i, "A").Value & ".xls"   
        FileCopy masterPath, dstpath
        DoEvents
        With Workbooks.Open(dstpath)
            .Worksheets(1).Range("E3") = ThisWorkbook.Worksheets(1).Cells(i, "A").Value
            .Save
            .Close
        End With
    Next
    ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite
End Sub
とすればいいかと思います。
（ウッシ）

ウッシ様へ

 今度は下記の箇所が黄色になってデバッグします。
    ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
 よろしくご指導お願いします。

 こんにちは
 "C:\Data\Master.xls" が開かれてる・・・このマクロが設定されたブックですか？

 原因不明なのでなんとなく、ブックが破損している感じですね。
 このコードは普通に標準モジュールに書いてあるんですよね？
 参照設定に参照不可の項目とか無いですよね？

 Master.xls がマクロブックと仮定して、Master.xlsを別の場所に退避しておいてから、
 新規ブックにシートの内容をコピーして、マクロもモジュール挿入してコピペして Master.xls という名前で
 保存してから、マクロ実行してみてもらえますか？

 （ウッシ）

 お邪魔します。
 見てて良くわからないのですが、もしかしたらこんな事なのでしょうか？

  Sub test()
  Const dataFolder = "D:\test\"           '★コピー先フォルダを指定
  Dim i As Long, tbl As Variant

  tbl = ActiveSheet.Range("A1").CurrentRegion.Value
  For i = 1 To UBound(tbl)
      ThisWorkbook.Worksheets("Sheet1").Range("E3").Value = tbl(i, 1)
      ThisWorkbook.SaveCopyAs dataFolder & tbl(i, 1) & ".xls"
  Next i
  ThisWorkbook.Worksheets("Sheet1").Range("E3").ClearContents
  End Sub

 （ｍｏｍｏ）

 こんばんは。
 最初に質問したでこです。
 私の方はウッシさんの回答でうまくいきました。
 ありがとうございました。
 もう一つ質問なのですが、ファイル数が月により変動する可能性があるのですが、
 毎回For i = 1 To 100のところの数字を変更する以外にどうしたらいいのでしょうか？
 ｍｏｍｏさんのコードが参考になるかもと思ったのですが、自分ではうまく修正
 できませんでした。

 (でこ)

 わたしのコードでは
 tbl = ActiveSheet.Range("A1").CurrentRegion.Value
 のように、最初にA1セルから続けてデータが入っているセル範囲のデータを取得しています。

 そして
 For i = 1 To UBound(tbl)
 のように１から取得したA1セルからの連続範囲の最後まで。
 としていますので、同じように変更してから
 ウッシさんのコードですと
 Cells(i, "A").Value　と
 ThisWorkbook.Worksheets(1).Cells(i, "A").Value
 の部分を　tbl(i,1) に変更すれば出来ると思います。
 （ｍｏｍｏ）

 ｍｏｍｏ様

 試してみたらうまくいきました。ありがとうございましたー。
 ｍｏｍｏさんのコードも今後の参考にさせて頂きます。

 (でこ)

コメント返信：

[ 一覧(最新更新順) ]

[[20100923200934]] 『コピーファイル名にセルの値』（でこ） ページの最後に飛ぶ

[[20100923200934]]　『コピーファイル名にセルの値』（でこ）　ページの最後に飛ぶ