• ベストアンサー
  • すぐに回答を!

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 みたいにすれば良いと思うのですが、開いている全てのファイルからのコピぺってどうやって記述するのでしょうか? 何卒よろしくお願い致します。

共感・応援の気持ちを伝えよう!

  • 回答数7
  • 閲覧数469
  • ありがとう数5

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.1
  • n-jun
  • ベストアンサー率33% (959/2870)

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)) でエラーが出るのですが、どうすれば良いのでしょうか? 何卒よろしくお願い致します。

関連するQ&A

  • EXCEL VBAで、PasteSpecialと Destinationの組み合わせ方法?

    ここで教えていただいたマクロで ActiveSheet.Paste Destination:=Workbooks(\"book1.xls\").Worksheets(\"Sheet1\").Range(\"A1\") のペースト部分を書式を除きたいので PasteSpecial Paste:=xlFormulas でやりたいのですが、どう組み合わせたらいいのかわかりませんでした。 おしえていただけませんでしょうか?

  • エクセルVBAでエラー、Changeの使い方が×?

    エクセルVBAでBOOK1のsheet1とsheet2とsheet3があり、 sheet1とsheet2の全ての情報をsheet3にコピーしてまとめるようにしました。 マクロを実行するには、Visual Basicを開いてF5を押しています。 それをsheet1かsheet2の中身の一部分でも変更すると そのときに自動的にマクロが実行されるようにしたいです。 sheet1とsheet2とsheet3に Private Sub Worksheet_Change(ByVal Target As Range) Call マクロ() End Sub を入れ、 標準モジュールに Sub マクロ() Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150") Dim UsedCell As Range Dim Max_Row, RowCount As Integer Set UsedCell = ActiveSheet.UsedRange Max_Row = UsedCell.Cells(UsedCell.Count).Row Application.ScreenUpdating = False For RowCount = Max_Row To 1 Step -1 If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then Rows(RowCount).Delete End If Next Application.ScreenUpdating = True End Sub をやって、sheet1かsheet2のセルを変更すると エクセルが固まってしまいます。 デバックでは最初の Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") がよくないようです。 書き方が間違っているのでしょうか?

  • Excel VBAで異なるファイル間のコピー

    異なるファイル間で値のみをコピーしたいです。下記の様な感じです。 hoge1.xlsのA1からA10のセルの値のみをhoge2.xlsのB1からB10へコピーする。 以下の様に書いてみたのですが、数式がコピーされてしまいます。 VBAをやったことがなく、今ネットで30分ほど見て書いてみたので 根本的に理解していません。簡単な書き方を教えていただきたいです。 Sub test() Dim Fname As String Fname = "hoge1.xls" Workbooks.Open Filename:=Fname, ReadOnly:=True Dim range1 As Range Set range1 = Worksheets("Sheet1").Range("A1:A10") range1.Copy Destination:=Workbooks("hoge2.xls").Worksheets("Sheet1").Range("B1:B10") End Sub また、ファイルを開いたり閉じたりは必要なのでしょうか? Workbooks.Open Filename:=Fname, ReadOnly:=True を書かずに、いきなり Set range1 = Workbooks("hoge1.xls").Worksheets("Sheet1").Range("A1:A10") はダメなのでしょうか?? よろしくお願いします。

その他の回答 (6)

  • 回答No.7
  • n-jun
  • ベストアンサー率33% (959/2870)

No.5です。 今更ですけど最初の質問で、 >Sub Mac() とありますがMAC版のExcelですか? もしそうなら未経験のため外しているかもしれません。 (こちらWinXP環境のみでしか、いじったことありませんので)

共感・感謝の気持ちを伝えよう!

  • 回答No.6
  • imogasi
  • ベストアンサー率27% (4616/16507)

下記を参考にしてみてください。 テストは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
  • ベストアンサー率33% (959/2870)

>開いているブックX.xlsというファイルのXというシートがあり Xと言うブックにコードを書いたとして Xと言うシートがアクティブでない状態でもと言うなら、 >Set ws1 = ThisWorkbook.ActiveSheet を Set ws1 = ThisWorkbook.Worksheets("X") としてみて下さい。 その位しか思いつきませんでした。。。

共感・感謝の気持ちを伝えよう!

  • 回答No.4
  • n-jun
  • ベストアンサー率33% (959/2870)

別段提示したコードでちゃんとデータは纏まっているようですけど。。。 (当方Excel2002で検証) 貼り付ける位置は2108行目から3108行目で宜しいのですよね? だいぶ下の方に貼り付けるわけですし、スクロールしてみても何もないのでしょうか? あとは実際のファイルでないと検証も難しいです。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

  • 回答No.3
  • n-jun
  • ベストアンサー率33% (959/2870)

>そのままコピぺして試してみたのですが、エラーは出ないのですが、 >何も起きないのですが・・・ >一体どこが悪いのでしょうか? 取り敢えずどのようなデータなのか、どのようなシートレイアウトなのか、どこに書き出すのか が不明ですので提示されたコードのみで考えてました。 1.コードはどのブックに書くのか。  そしてそのブックのどのシートに書き出すのか。  その書き出す位置(行列)はどこなのか。 2.データを取り出すブックとそのシートのデータ範囲はどこなのか。 等々の情報が必要かも。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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)) 1.どのブックかというのは開いているブックで開いているシートです。 書き出す位置(行列)は上記の通りです。 2.データを取り出すブックとそのシートのデータ範囲も上記の通りです。 何卒よろしくお願い致します。

  • 回答No.2
  • n-jun
  • ベストアンサー率33% (959/2870)

>開いている全てのワークブック にはコードを書いたブックは含まれないと仮定しています。 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 がどのシートなのか(どのブックの)を明確にする事が必要かと。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

関連するQ&A

  • ExcelのVBAについてです。

    例えば"Book1.xls"という名前のブックの"Sheet1"という名前のシートの一部を削除する。 これをVBAでやらせようと思うんですが、"Book1.xls"を開かずに行うことはできるんでしょうか。 Workbooks("Book1.xls").Worksheets("Sheet1").Range("C7:M51").ClearContents のようにしてるんですがうまくいきません。 "Book1.xls"はLAN上のブックで実際はフルパスで指定してます。 よろしくお願いします。

  • マクロについて教えてください。

    最近、勉強し始めました。 名簿を作成しています。Sheet1のデータを2種類に分けてSheet2(県外)、Sheet3(県内)のあらかじめ作成している表に振り分けたいのです。 しかしながら、1名分のデータをコピーして張り付けることはしたのマクロで出来たのですが、2名分もこのようにするとなると手入力したほうが速いような気がしています。 なにかいい方法がありましたら教えてください。 Sub コピーして別のシートに貼り付ける1() Worksheets("Sheet1").Activate Range("B11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("B10:E17") Range("C11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A18:E19") Range("D11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("F10:K17") Range("E11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("F18:K19") Range("F11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M10:S10") Range("G11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M11:S11") Range("H11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M12:S12") Range("I11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M13:S13") Range("J11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M14:S14") Range("K11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M15:S15") Range("L11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M16:S16") Range("M11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M17:S17") Range("N11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M18:S18") Range("O11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M19:S19") Range("P11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("T10:T19") Range("Q11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("U10:U19") Range("R11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("V10:V19") Range("S11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("W10:W19") Range("T11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("X10:X19") Range("U11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("Y10:Y19") Range("V11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("Z10:Z19") Range("W11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AA10:AA19") Range("X11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AB10:AB19") Range("Y11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AC10:AG19") End Sub

  • VBA ワークシートオブジェクトがうまく使えない

    以下のサブプロシージャ、動きません。 Sub main() Dim Thissheet As Worksheet Set Thissheet = ActiveSheet Workbooks.Open Filename:="Book2.xlsx" Range("A1").Copy Destination:=ThisWorkbook.Thissheet.Cells(1, 1) Range("B1").Copy Destination:=ThisWorkbook.Thissheet.Cells(1, 2) ActiveWindow.Close End Sub 機能:Book1.xlsxで上記マクロを起動すると、Book2.xlsxを開きセルの一部ををBook1にコピーし、閉じる エラーメッセージ: コンパイルエラー メソッドまたはデータ メンバーが見つかりません。 Range("A1").Copy Destination:=ThisWorkbook.Thissheet.Cells(1, 1) この行のThissheet.で引っかかります。 ちなみにThissheetの代わりにWorksheets(1)を用いるとうまくいきます。 Thissheetを用いた場合、何がマズイのでしょうか? 以下の認識で書いてますが、誤りあるでしょうか? ThisWorkbook=マクロが納められているワークブック、つまりBook1.xlsx Activesheet= 行を実行した時にアクティブになっているワークシート、ここではBook1.xlsxのマクロ起動時のワークシート

  • エクセルVBAで他のbookのセルcellsで参照

    エクセルVBAで他のbookのセルの値(一定の範囲)を参照したいのですが、変数を使いたいため、cellsを使用したいのですがうまくいきません。方法はないでしょうか。 下記に例を示します。 rangeを使用すればすべてok((2)(5))(この場合はset文を使用しなくてもok(5))。同じbookならcells使用ok(4)。 他のbookをcells文使用する方法はないでしょうか(もちろんできれば、Thisbookの方もcellsを使用したい)。 よろしくお願いします。 sub test() Dim ThisBook As Workbook Dim Workbook2 As Workbook 'マクロを実行しているワークブック Set ThisBook = ThisWorkbook '他のワークブック Set Workbook2 = Workbooks("test11.xlsx") ' 'ThisBook.Worksheets(1).Range("A1:B2").Value = Workbook2.Worksheets(1).Range(Cells(1, 1), Cells(2, 2)).Value  '(1)だめ 'ThisBook.Worksheets(1).Range("A1:B2").Value = Workbook2.Worksheets(1).Range("a1:b2").Value '(2) OK 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:B2").Value = Workbooks("test11.xlsx").Worksheets(1).Range(Cells(1, 1), Cells(2, 2)).Value '(3) だめ 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:B2").Value = Workbooks("test1.xlsm").Worksheets(1).Range(Cells(3, 3), Cells(4, 4)).Value  '(4)だめ 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:ii8000").Value = Workbooks("test11.xlsx").Worksheets(1).Range("a1:ii8000").Value  '(5) ok End Sub

  • コピー後に値のみ貼り付け エクセル、VBAの記述について

    マクロ初心者です。 エクセルで選択範囲を指定後コピーし、 自動的に別のシートの末尾に貼り付けられるようにしたのですが、 この内容のまま「貼り付け」を「値のみ貼り付け」に訂正する場合 どのように変更すればいいのか、教えてくださると嬉しいです。 宜しくお願いいたします。 Sub 選択範囲をコピー後、指定シートの末尾に貼り付け Worksheets("sheet1").Activate Range("b11:I17").Copy Workbooks("book2.xls").Worksheets("Sheet1").Activate 行 = Range("B1").CurrentRegion.Rows.Count + 1 ActiveSheet.Paste _ Destination:=Workbooks("book2.xls").Worksheets("Sheet1").Range("B" & 行) End Sub

  • ExcelのVBAについての質問です。

    ExcelのVBAについての質問です。 計測機器をつないでsheet1に数値が書き込まれていってる状況です。下記のプログラムを特定の時間内に複数回ループされるように設定したいのですが、そのようなプログラムを加えればいいのでしょうか? Sub Macro1() ' ' Macro1 Macro ' ' Dim iRows As Integer Dim sRows As String ' 最終行の調査: iRows = Worksheets("Sheet1").UsedRange.Rows.Count ' 最終行をシート3にコピー Worksheets("Sheet1").Rows(iRows).Copy Destination:=Worksheets("Sheet3").Range("1:1") ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B4").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("B5").Value = Worksheets("Sheet1").Cells(iRows, 4).Value End Sub

  • Excel VBA 指定シートの取込

    こんにちは。 ExcelのVBAを使用して、異なるBookのシートを取込みたいのですが、 シートが無かった場合の処理方法がわかりません。 現在のコードは下記の様になっております。 With Workbooks.Open"BOOK1.xls" .Worksheets("Sh1").Cells.Copy ThisWorkbook.Sheets("Sheet1").Range("A1") .Worksheets("Sh2").Cells.Copy ThisWorkbook.Sheets("Sheet2").Range("A1") .Worksheets("Sh3").Cells.Copy ThisWorkbook.Sheets("Sheet3").Range("A1") .Close End With Book1に指定したシートが無い場合、何もしないようにしたいのですが、 どの様に書き換えれば宜しいでしょうか? よろしくお願いします。

  • Excel VBA のコピーについて

    Range(Cells(7, 42), Cells(61, 79)).Select Selection.Cut Destination:=Range("B7") このような形で値をコピーしたいのですが、 その際、コピーされる方のRange("B7")の書式を そのまま生かしたい場合はどのような設定をすればよろしいのでしょうか? windows2000でexcel2000になります。 よろしくお願い致します。

  • VBA初心者です。値を貼り付け について質問です。

    VBA初心者です。 値を貼り付け について教えてください。 Sub test() With Workbooks("A.xls").Worksheets("sheet1") .Range("A1").Copy Workbooks("Bxls").Worksheets("sheet1").Range("B2") .Range("A2").Copy Workbooks("B.xls").Worksheets("sheet1").Range("B4") End With End Sub コピーする方に計算式が入っているので 値を貼り付け したいのですが、どうすればいいのでしょうか? PasteSpecial Paste:=xlPasteValues を使ったらよいというところまではわかったのですが・・・。 教えてください!よろしくお願いします!

  • ExcelのVBAについて質問です。Excelは2003です。

    ExcelのVBAについて質問です。Excelは2003です。 コマンドボタン1で下記のプログラムを実行するようにしています。 Sub Macro1() ' ' Macro1 Macro ' ' Dim iRows As Integer Dim sRows As String Dim i As Integer For i = 1 To 100 Application.Wait Now + TimeValue("00:00:05") ' 最終行の調査: iRows = Worksheets("Sheet1").UsedRange.Rows.Count ' 最終行をシート3にコピー Worksheets("Sheet1").Rows(iRows).Copy Destination:=Worksheets("Sheet4").Range("1:1") ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B9").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("C9").Value = Worksheets("Sheet1").Cells(iRows, 4).Value Next i End Sub これをコマンドボタン2で途中でも強制的に終了するようにしたいのですがコマンドボタン2にはどのようなプログラムを入れればいいでしょうか?