Excel VBAで他のワークブックからのコピぺの仕方について

質問

Excel VBAで開いている全てのワークブックから決められたセルの中身とそのシート名をそれぞれ決められた一つのワークブックにコピぺする
マクロを作りたいのですが、どうやって作って良いのかが分かりません。

例えば、
Sub Mac()

For i = 1 To 100
Workbooks("Book1.xls").Worksheets("sheet1").Range(Cells(2108, 2), Cells(3108, 2)).Cut Destination:=Workbooks("Book1.xls").Worksheets("sheet1").Cells(13, 2)

End Sub
みたいにすれば良いと思うのですが、開いている全てのファイルからのコピぺってどうやって記述するのでしょうか？
何卒よろしくお願い致します。

回答No.1

n-jun · ベストアンサー

Sub try()
Dim wb As Workbook

For Each wb In Workbooks
MsgBox "このブックの名前は、" & ThisWorkbook.Name & vbLf _
& "今選んでいるブックの名前は、" & wb.Name
Next

End Sub

ご参考程度で。

お礼

ありがとうございます。

いろいろと自分なりに考えてみたのですが、

Sub Sample1()
c = 2
For Each W In Workbooks
For Each ws In Worksheets
Cells(12, c) = ws.Name
Range(Cells(2108, c), Cells(3108, c)) = W.ws.Range(Cells(2108, 2), Cells(3108, 2))
c = c + 1
Next
Next
End Sub

ここまではできたのですが、
どうしてもエラーが出てきます。
Range(Cells(2108, c), Cells(3108, c)) = W.ws.Range(Cells(2108, 2), Cells(3108, 2))
でエラーが出るのですが、どうすれば良いのでしょうか？
何卒よろしくお願い致します。

回答No.7

n-jun

No.5です。

今更ですけど最初の質問で、
＞Sub Mac()
とありますがＭＡＣ版のＥｘｃｅｌですか？
もしそうなら未経験のため外しているかもしれません。
（こちらＷｉｎＸＰ環境のみでしか、いじったことありませんので）

回答No.6

imogasi

下記を参考にしてみてください。
テストはBook1を開き、そこから
xxx.xls,
yyy.xls
を開き下記実行しました。
Book1のSheet4というシートのA列に、各シートのA1セルの値を、順次代入してます。Book1のSheet4以外のシートのA1セルのデータも集めています。
Msgboxは確認用で、確認が済めば削除してください。
ーー
Sub test01()
i = 1
Dim ws As Worksheet
For Each wb In Workbooks
For Each sh In wb.Worksheets
If wb.Name = "Book1" And sh.Name = "Sheet4" Then GoTo p01
'MsgBox wb.Name & " " & sh.Name
MsgBox wb.Name & "= " & sh.Name & "= " & "A1= " & sh.Range("A1")
Workbooks("Book1").Worksheets("sheet4").Cells(i, "A") = sh.Range("A1")
i = i + 1
p01:
Next
Next
End Sub
ーー
結果　Sheet4のA列　A1:A9
tts1
yys2
yys3
東京
tts2
0.666666667
tts4
はい
tst1
一致を確認しました。

回答No.5

n-jun

＞開いているブックX.xlsというファイルのXというシートがあり
Ｘと言うブックにコードを書いたとして
Ｘと言うシートがアクティブでない状態でもと言うなら、

＞Set ws1 = ThisWorkbook.ActiveSheet
を
Set ws1 = ThisWorkbook.Worksheets("Ｘ")
としてみて下さい。

その位しか思いつきませんでした。。。

回答No.4

n-jun

別段提示したコードでちゃんとデータは纏まっているようですけど。。。
（当方Ｅｘｃｅｌ２００２で検証）

貼り付ける位置は２１０８行目から３１０８行目で宜しいのですよね？
だいぶ下の方に貼り付けるわけですし、スクロールしてみても何もないのでしょうか？

あとは実際のファイルでないと検証も難しいです。

お礼

現在、開いているブックX.xlsというファイルのXというシートがあり、そのほか開いている001.xls、002.xls、003.xls・・・というファイルの中の001、002、003・・・というシートのBの２１０８行目から３１０８行目のデータをX.xlsというファイルのXというシートのA、B、C、・・・列目の２１０８行目から３１０８行目にコピーしたいということですよ。

どうしてもうまくいかないのですが・・・

回答No.3

n-jun

>そのままコピぺして試してみたのですが、エラーは出ないのですが、
>何も起きないのですが・・・
>一体どこが悪いのでしょうか？
取り敢えずどのようなデータなのか、どのようなシートレイアウトなのか、どこに書き出すのか
が不明ですので提示されたコードのみで考えてました。

１．コードはどのブックに書くのか。
　そしてそのブックのどのシートに書き出すのか。
　その書き出す位置（行列）はどこなのか。

２．データを取り出すブックとそのシートのデータ範囲はどこなのか。

等々の情報が必要かも。

お礼

001.xls、002.xls、003.xls・・・というファイルの中の001、002、003・・・というシートから
それぞれ同じ箇所のセルからデータを抜き出したいのですが。

Range(Cells(2108, c), Cells(3108, c)) = W.ws.Range(Cells(2108, 2), Cells(3108, 2))

１．どのブックかというのは開いているブックで開いているシートです。
書き出す位置（行列）は上記の通りです。
２．データを取り出すブックとそのシートのデータ範囲も上記の通りです。

何卒よろしくお願い致します。

回答No.2

n-jun

＞開いている全てのワークブック
にはコードを書いたブックは含まれないと仮定しています。

Sub Sample1_next()
Dim wb As Workbook
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim c As Long

Set ws1 = ThisWorkbook.ActiveSheet

c = 2
For Each wb In Workbooks

If wb.Name <> ThisWorkbook.Name Then

For Each ws In wb.Worksheets

With ws1
.Cells(12, c) = ws.Name
.Range(.Cells(2108, c), .Cells(3108, c)).Value = _
ws.Range(ws.Cells(2108, 2), ws.Cells(3108, 2)).Value
c = c + 1
End With

Next

End If

Next

Set ws1 = Nothing
End Sub

試してないですが、たぶんこんな感じかと。

Range,Cells　がどのシートなのか（どのブックの）を明確にする事が必要かと。

お礼

ありがとうございます。

そのままコピぺして試してみたのですが、エラーは出ないのですが、
何も起きないのですが・・・
一体どこが悪いのでしょうか？