エクセルマクロで、複数ファイルにある全シートの情報を、別ファイルの1シートに転記したいのですが、なかなか上手く行きません。（ほぼ初心者です。）
詳細は↓です。どなたかご教授の程よろしくお願いいたします。
【やりたいこと】
同一フォルダ内にある約60個のファイルの、全てのシート内の情報を別の集計用ファイルに転記する。
(1) ファイル毎にばらばらなシート名＆シート数で、これら全てのデータを集計用ファイルに転記するには？（シート数は1ファイルあたり1シートから最大13シート）
(2) 以前に似たような作業をした時は、ファイル名をいちいち集計用ファイルにコピペして読み込ませたが、こうした手間を掛けずに一括処理するには？
※転記作業自体は「マクロの記憶」機能で書き出すので、それ以外の、特に始まりと終わりの部分を教えて下さい。
※転記内容自体はあまり複雑ではなく、集計用ファイルに1シート1行として転記し、ズラッと下に120行書き込むつもりです。
説明が分かりづらい部分があればご指摘ください。よろしくお願いいたします。
投稿日時 - 2009-10-05 21:47:05
1人が「このQ&Aが役に立った」と投票しています
回答（4件中 1～4件目)
No.2です。
コードを詳しく読んでは居ませんが、横方向にたくさん貼り付けて居るにも関わらず、アクティブセルを1つ右に動かすだけで次の貼り付けを行っているように見えます。
「ActiveCell」は非常にデバックしづらいので、RangeやCellsなどで、明示的にセルアドレスを指定しましょう。
そこに気を付けて修正すれば正しく動くと思います。
■修正箇所一部抜粋
＃'作業の本体マクロ'から8行目
ActiveCell.Offset(8, 1).Range("A1").Select
↓
Cells(8 * nRow,1).Select
＃「・・・こんな調子でズラズラと横にコピー…」の3行上
ActiveCell.Offset(0, 1).Range("A1").Select
↓
Cells(8 * nRow,11).Select
あと、Offsetの使い方もおかしいです。
ActiveCell.Offset(0, 1).Select 「アクティブセルの右のセルを選択」か、
Range("A1").Offset(0, 1).Select 「A1セルの右（B1)を選択」
の様に使います。
投稿日時 - 2009-10-06 20:02:27
お礼
mt2008さま
ありがとうございました。
無事解決です！！！
本当に助かりました。
投稿日時 - 2009-10-06 21:46:47
No.2です。
> これは、私が作った作業の本体マクロに、コピー先として固定された行が指定されているからだと思うのでが。
その固定された行を変数にして、1行書き込むたびに1増やして行きましょう。
私のサンプルコードでは、変数「nRow」が書き込む際の行になっています。
その部分のコードを示してもらえれば、もう少し具体的なアドバイスが出来るのですが……。
投稿日時 - 2009-10-06 17:57:55
補足
mt2008さま
本当に色々とありがとうございます。
さっそく具体的な（現在の間違った）コードを貼ります。
※一応、「作業の本体マクロ」を相対参照に書き換えてあります。
が、2つ目のデータを自ブックにコピーする際、
1つ目データコピーが終了したセルから開始されてしまいます。
Dim wb As Workbook
Dim ws As Worksheet
Dim sPath As String
Dim sFile As String
Dim nRow As Long
nRow = 1
sPath = "***\" '対象フォルダ（書き換えて）
'Dirの結果が空白になるまで（＝全てのファイルを処理するまで）ループ
sFile = Dir(sPath & "*.xls")
Do While sFile <> ""
Set wb = Workbooks.Open(sPath & sFile) '対象BookをOPEN
For Each ws In wb.Worksheets '対象ブックの全シート分、ループ
'作業の本体マクロ'
wb.Activate
ws.Select
Selection.Copy
Range("G16:P16").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
ActiveCell.Offset(8, 1).Range("A1").Select
ThisWorkbook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb.Activate
ws.Select
Range("G17:I17").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
・・・こんな調子でズラズラと横にコピーをし、↓の様に終わらせています。
wb.Activate
Range("G104:P107").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
nRow = nRow + 1
Next ws
wb.Close SaveChanges:=False '開いたBookを閉じる
sFile = Dir()
Loop
End Sub
※ほんとにハチャメチャでお恥ずかしいですが、アドバイスの程よろしくお願いいたします。
投稿日時 - 2009-10-06 18:29:57
特定フォルダの、全ブックの全シートに対して処理を行うサンプルです。
例として、全てのシートのA1セルの値を自ブックのA列に書いています。
なお、このマクロを含んだBookは、対象フォルダに入れないで下さい。
Sub Sample()
Dim wb As Workbook
Dim ws As Worksheet
Dim sPath As String
Dim sFile As String
Dim nRow As Long
nRow = 1
sPath = "C:Path\"'対象フォルダ（書き換えて）
'Dirの結果が空白になるまで（＝全てのファイルを処理するまで）ループ
sFile = Dir(sPath & "*.xls")
Do While sFile <> ""
Set wb = Workbooks.Open(sPath & sFile) '対象BookをOPEN
For Each ws In wb.Worksheets '対象ブックの全シート分、ループ
'例として、各シートのA1セルの値を自ブックのアクティブシートA列に列挙
ThisWorkbook.ActiveSheet.Cells(nRow, 1) = ws.Cells(1, 1)
nRow = nRow + 1
Next ws
wb.Close SaveChanges:=False '開いたBookを閉じる
sFile = Dir()
Loop
End Sub
投稿日時 - 2009-10-06 10:12:14
補足
mt2008さま
ご回答いただきまして本当にありがとうございます。
テストバージョンではバッチリでした！
が、実物を使うと引っかかってしまいました（初心者ですみません）。
引っかかっているのは、1シートを読み込んだ後に、次のシートを読み込むと、自ブックの同一行上に書き込んでしまうことです。
（全部上書きされて、数十シートを読み込んでも、結果的に1行しか残りません）
これは、私が作った作業の本体マクロに、コピー先として固定された行が指定されているからだと思うのでが。
※作業のマクロは、「マクロの記録」機能を使って一つ一つ書き出したものなので、A3用紙に印刷すると5ページ位に及びます。
時間はかかりますが何とか最後までコピーは終わります。
が、100行あるはずのものが結果的に1行しか作成されてない状態です。
よい解決策がありましたご指導のほどよろしくお願いいたします。
投稿日時 - 2009-10-06 16:36:29
OKWaveのオススメ
おすすめリンク
