[[20090911171355]]　『複数のエクセルファイルの指定シートを統合する』（ななし）　ページの最後に飛ぶ

『複数のエクセルファイルの指定シートを統合する』（ななし）

 エクセルファイルが10個ほどあります。（名前はそれぞればらばらです）

 そのなかのシートは全て同じ名前です。
 シートA、シートB、シートC・・・・シートF

 シートAのみを集約したひとつのエクセルファイルを作りたいとおもい
 下記マクロを組みましたが、同じところでエラーがでます

 Sub treatAllFiles()
 Dim FSO As Object
 Dim folderName As String
 Dim targetFolder As Object
 Dim targetFiles As Object
 Dim targetFile As Object
 Dim sh As Worksheet

 'フォルダー名は環境に合わせる事
 folderName = "C:\Documents and Settings\*****\デスクトップ\作業用\"
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set targetFolder = FSO.getfolder(folderName)
 Set targetFiles = targetFolder.Files
 For Each targetFile In targetFiles
 DoEvents '途中でやめたくなった時のための保険
 If UCase(Right(targetFile, 4)) = ".XLS" Then
 Application.Workbooks.Open FileName:=targetFile, UpdateLinks:=False
 For Each sh In Application.ActiveWorkbook.Worksheets
 If sh.Name = "シートA" Then
 sh.Copy Before:=ThisWorkbook.Sheet1
 ActiveSheet.Name = FSO.GetBaseName(targetFile)
 End If
 Next
 Windows(FSO.GetFileName(targetFile)).Activate
 Call ActiveWorkbook.Close(savechanges:=False)
 End If
 Next targetFile
 End Sub

 エラーがでる箇所

 sh.Copy Before:=ThisWorkbook.Sheet1

 修正の方法を教えてください。

 もしくは、ほかに良い方法があったら教えてください。
 よろしくお願いいたします。

 同じ名前のシートをコピーしようとしているのですから当然エラーになりますよね？

 ActiveWorkbook.Close savechanges:=False
 と保存せずに閉じているのですから

 >sh.Copy Before:=ThisWorkbook.Sheet1
 >ActiveSheet.Name = FSO.GetBaseName(targetFile)

 の順番を入れ替えて、なおかつ

 sh.Name = FSO.GetBaseName(targetFile)
 sh.Copy Before:=ThisWorkbook.Sheet1

 のようにされてみてはどうでしょうか？
 （ｍｏｍｏ）

 それと、少し気になるのですが
 > ThisWorkbook.Sheet1
 Index では無く、CodeName を使用していますがこれは何か意味がありますか？
 私はこのような場合に極力避けています。
 万が一削除されたらアウトですよ？
 (seiya)

お返事ありがとうございます。

 特に意味はなく、既存のVBAをコピーして使用したため、元から入っていました。
 この行は削除したほうが良いでしょうか？

 また、先ほどアドバイスいただきました内容に下記のように変更してみました。

 If sh.Name = "シートA" Then

 sh.Name = FSO.GetBaseName(targetFile)

 sh.Copy Before:=ThisWorkbook.Sheets(1)

 End If
 Next

 と書き換えてみたところ、
 sh.Copy Before:=ThisWorkbook.Sheets(1)
 のところで

 【"Copy"デバックは失敗しました】
 というエラーメッセージがでてしまいます。
 何が原因なのでしょうか・・・

 >特に意味はなく、既存のVBAをコピーして使用したため、元から入っていました。この行は削除したほうが良いでしょうか？ 
 は、私のコメントに対するものと考え...

 sh.Copy Before:=ThisWorkbook.Sheet(1)
                                   ^^^
 私なら、このようにしておきます。
 とりあえず...
 (seiya)

(seiya)さん

 御指摘ありがとうございます。

 sh.Copy Before:=ThisWorkbook.Sheet(1)

 へ変更したところ、メゾットが見つかりませんというエラーがでて、
 マクロが動かなくなってしまいました。

 試す時間が無いので申し訳ないですが、少し修正しつつ整理してみました

  Sub treatAllFiles()
  Dim folderName As String
  Dim targetFile As Object
  Dim sh As Worksheet
  folderName = "C:\Documents and Settings\*****\デスクトップ\作業用\"
  With CreateObject("Scripting.FileSystemObject")
    For Each targetFile In .GetFolder(folderName).Files
      If .GetExtensionName(targetFile.Path) = "xls" Then
        With Application.Workbooks.Open(Filename:=targetFile.Path, UpdateLinks:=False)
          For Each sh In .Worksheets
            If sh.Name = "シートA" Then
              sh.Name = sh.Parent.Name
              sh.Copy Before:=ThisWorkbook.Sheets(1)
            End If
          Next
          .Close False
        End With
      End If
    Next targetFile
  End Sub

 （ｍｏｍｏ）

 s が抜けました...

 sh.Copy Before:=ThisWorkbook.Sheets(1)
                                   ^
 すみません。
 (seiya)

 MOMOさんにいただいたVBAに修正したところ   End With
 が不足していますとエラーがでました

 知識不足でもうしわけありません

 Dir関数を使用して...

 Sub test()
 Dim myDir As String, fn As String, ws As Worksheet
 myDir = "C:\Documents and Settings\*****\デスクトップ\作業用\"
 fn = Dir(myDir & ".xls")
 Do While fn <> ""
     With Workbooks.Open(myDir & fn, 0)
         For Each ws In .Sheets
             If ws.Name = "シートA" Then
                 ws.Name = fn
                 ws.Copy Before:=ThisWorkbook.Sheets(1)
                 Exit For
             End If
         Next
         .Close False
     End With
     fn = Dir
 Loop
 End Sub
 (seiya)

 あ、ほんとですね。
 End Subの前に　End With　入れてください。
 （ｍｏｍｏ）

すみません、御回答ありがとうございます。

 頂いた御回答で設定してみたのですがやはり出来ませんでした。

 シートの名前を変更してほごしますか？と聞かれます。

 元ファイルは何も替えず、
 複数ある、Excelファイルの同じシート名のものだけ集約して、
 ひとつのEXCELブックを作りたいのですが、不可能なのでしょうか････

 seiyaさん
 御回答ありがとうございます。
 モジュールコードに頂いたvbaを書き込んだのですが、
 何も動作しません・・・
 なぜでしょう・・・・

 （ななし）

同じシート名だと、持ってくることは不可能なのでしょうか

 であれば、先にワークシートを用意して中身だけコピーする方法はどうですか？
 （ｍｏｍｏ）

コメント返信：

[ 一覧(最新更新順) ]

[[20090911171355]] 『複数のエクセルファイルの指定シートを統合する』（ななし） ページの最後に飛ぶ

[[20090911171355]]　『複数のエクセルファイルの指定シートを統合する』（ななし）　ページの最後に飛ぶ