複数ファイルの特定のセルをコピーして１つにまとめる方法

2023/08/08 18:00

このQ&Aのポイント

複数のファイルから特定のセルをコピーして1つのファイルにまとめたい場合、セル範囲を指定してコピーする方法と、セルの範囲を動的に指定する方法があります。前者は決まったセル範囲をコピーする際に便利ですが、後者は条件によってセル範囲が変わる場合に有効です。
方法1では、`wkb.Sheets("Sheet1").Range("A1:D5").Copy`のように、コピー元のセル範囲を直接指定し、コピー先のファイルに貼り付けます。一方、方法2では、`wkb.Sheets("Sheet1").Range(Cells(1, 1), Cells(5, 5)).Copy`のように、`Cells`関数を使ってセルの範囲を動的に指定します。
しかし、方法2では"1004でエラー"となることがあります。このエラーは、`Cells`関数が正しくワークシートを参照できていないために発生します。このエラーを解消するためには、`Cells`関数の前に`wkb.Sheets("Sheet1").Activate`を追加することで、正しく参照されるようになります。

ベストアンサー

複数ファイルの特定のセルをコピーして１つにまとめる

2009/08/02 23:37

１つのフォルダ内の複数のファイル（Sheet1のみ)から、特定のセルをコピーして、１つのファイルにまとめたいと思っています。変数　wkb 複数のファイル　myb 自分のファイル (1) wkb.Sheets("Sheet1").Range("A1:D5").Copy myb.Sheets("統合").Cells(i, "A").PasteSpecial Paste:=xlPasteValues このように書いた場合、うまくいくのですが (2) wkb.Sheets("Sheet1").Range(Cells(1, 1), Cells(5, 5)).Copy myb.Sheets("統合").Cells(i, "A").PasteSpecial Paste:=xlPasteValues このように書くと、1004でエラーとなります。本来は、Sheet1の１行目から５行目までの中で、値がある行までコピーしたいので、（つまり1～3行目のときもあれば、1行目だけのときもある。）(2)の方法で実行したいのです。なんとかいい方法はないでしょうか？

phoenix062
お礼率77% (137/176)

Visual Basic
回答数1
ありがとう数1

みんなの回答 （1）
専門家の回答

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

ベストアンサー

masa_019
ベストアンサー率61% (121/197)

2009/08/03 00:07 回答No.1

こんにちは。 Cellsプロパティの対象オブジェクトを省略して記述しているせいではないでしょうか？ wkb.Sheets("Sheet1").Range(wkb.Sheets("Sheet1").Cells(1, 1), wkb.Sheets("Sheet1").Cells(5, 5)).Copy myb.Sheets("統合").Cells(i, "A").PasteSpecial Paste:=xlPasteValues 上記のようにすれば、エラーにならないと思います。 wkb.Sheets("Sheet1")を何回も記述するのはスマートじゃないので、通常は以下のように書きます。 With wkb.Sheets("Sheet1") .Range(.Cells(1, 1), .Cells(5, 5)).Copy End With myb.Sheets("統合").Cells(i, "A").PasteSpecial Paste:=xlPasteValues

質問者

お礼 2009/08/03 00:19

うまくいきました。ありがとうございます。

関連するQ&A

VBA空白を除いてコピーが出来ません。ご指導お願いします。
値のコピー＆ペースト（空白を除いてコピー）したいと思っております。シート１　の　A35、D35、I35　をコピー。シート２　の　A2　に貼り付け。これは、大丈夫です。シート１　の　M2　：　O23　をコピー。シート２　の　E2　に貼り付け。今回の場合ですと、M2　：　O13　までに値が入ってます。ですので、M14　：　O23　までが、空白になって記入となってしまいます。＊毎回、値が入る量が違います。一回のコピーですと、これでもいいのですが、値を変更して、コピーを続けてしますので、M14　：　O23　までが、空白になってM24からのコピーになってしまいます。空白を除いて、貼り付けしたいのですが、どうすればいいのかわかりません。お分かりになる方、ご指導よろしくお願いします。 VBAは以下になっております。 Sub Macro1() ' Application.ScreenUpdating = False Sheets("Sheet1").Range("A35,D35,I35").Copy If Sheets("Sheet2").Range("A2").Value = "" Then Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Sheets("Sheet1").Range("M2:O23").Copy If Sheets("Sheet2").Range("E2").Value = "" Then Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
EXCEL　VBAで複数行のコピー（バックグランド）
EXCELのVBAで質問します。複数行をコピーしてPasteを行う方法がわかりません。フォアグランドでは正しく実行できるのですが、バックグランドで実行した場合は、１行しかPasteできません。お分かりの方いらっしゃれば教えてください。コードは以下のとおりです。 Sheets(\"DATA\").Select Range(\"A3:W26\").Select Selection.Copy Range(\"A4\").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True 宜しくお願いします。
- ベストアンサー
- Visual Basic
指定セルをコピー
A2~A5,D2~D5,G2~G5をコピーしJ~P列2~5行に値を貼付け続いて9~13行、16~20行もJ~P列に貼り付けたいのですが7~8,14~15行にはセル結合されているところもあります。VBAで下記コードを入力しましたがあまりにデータが多く何か良い方法VBAコードはありますか。(For~Nextなど使用すれば良いのでしょうか) 環境はoffice2013です。 Range("A2:A6").Select Selection.Copy Range("J2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D2:D6").Select Selection.Copy Range("M2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 　Application.CutCopyMode = False
- ベストアンサー
- Excel（エクセル）
複数シートをループさせてマクロを簡素化したい
win7 Excel2007 でマクロ作成中の初心者です。シート数の変動する複数シートの特定範囲を一枚のシートに右列方向に、値を貼り付けたいです。自動記録でコード作成しましたが、もっと簡素化して軽くしたいです。シートに対するループ等の作成ができません。どうかご指導お願いします。 Sub 勤怠最終データ作成() Worksheets(1).Select '1番左のシートを選択 ActiveSheet.Unprotect Range("B29:BM60").Select '複写範囲はすべて同じ Selection.Copy Sheets("総括").Select '値の貼り付けシートはすべて同じ Range("A2").Select '値の貼り付け先 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(2).Select '2枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 '値の貼り付け先 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(3).Select '3枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(4).Select '4枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 Selection.PasteSpecial Paste:=xlPasteValues 以下省略 End Sub
- ベストアンサー
- Visual Basic
マクロでコピー＆ペースト処理が遅いような気がします。単純化したいです。
Sub ***出力(file, num) Workbooks.Open (file) Cells.Clear Windows("xxx.xls").Activate Sheets("***").Select Range(num & "2:" & num & "2000").Select Selection.Copy Windows(file).Activate Range("A1").PasteSpecial Paste:=xlPasteValues End Sub 2行目から2000行目の中には計算値が入っています（結構ながい）。その値を"file"に値のみペーストします。しかし、処理が遅いので早くしたいです。単純化できないでしょうか？
- ベストアンサー
- オフィス系ソフト
エクセルのマクロで各Sheetのデータを複数コピー&ペーストしたいです
エクセルのマクロで各Sheetのデータを複数コピー&ペーストしたいです１つのエクセルファイルの中に複数のSheetがあります。各Sheetの4行目以降（5行目から）にデータのあるA列～O列をコピーしていって、挿入-ワークシート（Sheet1という名前で構わない）に全てを順番にコピーしていきたいです。 ”新しいマクロの記録”で下記のように作成したのですが、　・5行目からデータのあるA列～O列をコピーしていく　　・存在する全てのSheetから上記の作業をするというマクロの書き方が分かりません。恐れ入りますがお時間ある方で上記の内容をご理解頂ける方がいましたらアドバイス頂ければ非常に助かります。 Sub Macro1() Sheets.Add Sheets("ER10(zy)").Select Rows("5:8").Select Selection.Copy Sheets("Sheet1").Select ActiveSheet.Paste Sheets("ER10(cx)").Select Rows("5:9").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("A5").Select ActiveSheet.Paste Sheets("ER10(zht)").Select Rows("5:13").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("A10").Select ActiveSheet.Paste End Sub
- ベストアンサー
- その他MS Office製品
エクセルVBA　での繰り返し処理について
エクセルVBA　での繰り返し処理について以下の作業を２０回繰り返そうとしています（別シートから持ってきた値を「行列を入れ替えて」貼り付け）　　 Sheets("初期設定").Select Range("A6:C6").Select Selection.Copy Sheets(TS).Select Range("B4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True 　　「初期設定」シートの方は1行ずつ並んでいるので、「2回目」の「2行目」は　　「 Range("A7:C7").Select」になり、　　「TS」シートの20行後に貼り付けたいので、「2回目」の「5行目」は　　「Range("B24").Select」　になります　　これを、for ～　next　を使い、以下のようにしてみましたが、上手くいきません。　　 For j = 6 To 26 For k = 4 To 384 Step 20 Sheets("初期設定").Select Range(Cells(j, 1), Cells(j, 3)).Select Selection.Copy Sheets(TS).Select Cells(k, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Next k Next j 　1分程度ループし続けた後、「初期設定」シートの最終行だけが貼り付けられてしまいました。どこをどのように直せばいいのかお教えください。よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
VBA　他のブックから複数のシートのデータをコピー
VBA初心者です。他のブックの複数のシートの最終行のデータをコピーし1つのシートにまとめたいと思っています。参照元シート1　最終行20　AからD シート2　最終行30　AからD シート3　最終行15　AからD　のそれぞれのデータメインシート 1行目　シート1のAからD 2行目　シート2のAからD 3行目　シート3のAからD　を値のみ貼り付けたいです色々と検索しチャレンジするシート1のみであればなんとか成功するまで完成したのですが、インデックスが有効ではありませんとでてエラーがでます。原因は、シート2のデータをコピーする際、参照元のファイルがActiveになっていないからだと考えているのですが、参照元のファイル名が毎回違いますので、ファイルを選択してファイルを開いてから作成しようとチャレンジしています。 Sub Copy() 'コピー元のファイルを選択して開く Dim OpenFile As String ChDir "C:\Users\name\Documents\folder" OpenFile = Application.GetOpenFilename("Excelブック,*.xlsx") MsgBox OpenFile & " を開きます" Workbooks.Open FileName:=OpenFile 'データをコピー 'シート1 Worksheets("シート1").Range("A20:D20").Copy Workbooks("メインブック.xlsm").Worksheets("メインシート").Activate Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'シート2 Worksheets("シート2").Range("A30:D30").Copy Workbooks("メインブック.xlsm").Worksheets("メインシート").Activate Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 良きアドバイスよろしくお願いします。
- ベストアンサー
- Excel（エクセル）
エクセルマクロ　繰り返して、別のシートへコピーしたい
エクセルマクロ　繰り返して、別のシートへコピーしたいマクロ初心者のため、やり方が全くわかりません。どなたか教えてください。やりたいことは、コピーするシートはあらかじめ作成しています。簡素化の方法がわからないので、とりあえず自分で作ってみたものが下にあるものです。繰り返す方法がわからないので、どなたか教えてください。よろしくお願いします。以下、作成したマクロです。 1行目から１０行目まで繰り返したくて、 1行目から2行目のセルの移動の差は１０行目までかわりません。 '1行目 Sheets("Sheet1").Select Range("B14:C14").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B15:C17").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False '2行目 Sheets("Sheet1").Select Range("B18:C18").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B19:C21").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B2").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False
- ベストアンサー
- オフィス系ソフト
マクロを使ったコピペがうまく動作しない。
あるデータを転記用のブック（月毎にシートが分かれています。シートの内容は同一）に貼り付ける処理を行うため、下記のようなマクロを組んだのですが、何故か貼りつきません。処理終了時には、転記元ブック（シート）で最終処理の範囲（５番目のB287）を選択しています。一体何がいけないのでしょうか？データはA1からPまでで毎月可変しています。また、転記用ブックが12枚あるため、月を指定してから貼り付けたいのですが、どのようにすればよいでしょうか？（下記は直接シ－トを指定しました） Sub test() Dim 最終行 As Integer '-------------------------------------------- 開始 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("1").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B1").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 1 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("2").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B83").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 2 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("3").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B157").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 3 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("4").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B227").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 4 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("5").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B287").PasteSpecial Paste:=xlPasteValues --------------------------------------------- 5 End　Sub　
- 締切済み
- オフィス系ソフト