Excel VBAで複数のシートからデータを連続して貼り付ける方法

前へ 次へ
このQ&Aのポイント
  • Excel VBAを使用して、複数のシートから連続してデータを貼り付ける方法を紹介します。
  • B5からD列の最終行までのデータをシート1からシート3に貼り付けます。
  • また、B5からD列の最終行までのデータをシート2からシート8の次の行に貼り付けます。
回答を見る
  • ベストアンサー

空欄もある別シート(複数)からの指定列コピー

シート1、シート2のB5～D列最終行までをシート3のB5～E列に連続して貼り付けたいのですが、他の回答にあった下記の方法で試したところ、B5～E列最終行にデータがない場合、B4～E4のタイトル行が貼り付けられてしまいました。 lngR = SH1.Range("B65536").End(xlUp).Row SH1.Range("B5:D" & lngR).Copy Destination:=SH3.Range("B5") lngR = SH2.Range("B65536").End(xlUp).Row SH2.Range("B5:D" & lngR).Copy _ Destination:=SH8.Range("B65536").End(xlUp).Offset(1) 回避するにはどのようにしたらよいでしょうか？ あるいは他に簡単な方法はありますか？ ※このブックには関連しないシート4が存在します。

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

  • ベストアンサー
回答No.1

2、4行目を If lngR > 4 Then　… とすればいいのでは？

ZERO-123
質問者

お礼

ありがとうございます。 理解しました。 予備知識程度は自分で勉強するべきなのでしょうが、全て、この場での他の方々の質問や回答を元に試行錯誤しているド素人です。 素早い回答に感謝します。 私の質問に誤記がありましたが御容赦下さい。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • シート1のC列の最終行をコピーして同じ行に値貼り付けしたい

    シート1のC列の最終行を取得して その行を丸々値貼り付けするマクロを作りたいと思います。 シート3のB18の値をシート1のC列の最終行の1つ下のセルに値貼り付け すると、その行のA、B列に日付が入力される関数が入っています。（下まで） 関数が入ったままだと、うまくいかない時があるので最終行をコピーして値貼り付けしたいのですが、マクロの作り方を教えてください。 シート1の最終行に貼り付け Sheets("Sheet3").Select Range("B18").Select Selection.Copy Sheets("Sheet1").Select Range("C65536").End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub 最終行をコピーして値貼り付け Dim 最終行 As Integer 最終行 = Range("C65536").End(xlUp).Row Range("A6:C" & 最終行).Select Selection.Copy Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub このマクロだと、A6からC列の最終行まで全てコピーされてしまうので、C列の最終行のAからC列まで1行だけコピーできないでしょうか？

  • 複数のシートを１つのシートにコピーしたい

    VBA初心者です。よろしくお願いします。 【状況】 １つのワークブックの中に『まとめ』という名前のシート、それ以外にコピーしたいシートが複数あります。 コピーしたくないシートもあります。 まとめを一旦クリアし、コピーしたいシートだけをコピーして貼り付けたいです。 まとめシートもコピーしたいシートも、データの入っているセルは"B5"から始まり、M列までの任意の行までデータが入っています。（B5：M？） 【やりたいこと】 コピーしたいシートのみ、データの入っている範囲をコピーして、まとめシートに貼り付けたい。 最終行を取得するVBAはいろいろなサイトを参考に書くことができたのですが、そこから"B5"までの範囲を指定してコピーをするという方法がいまいち分かりません。 参考にしたサイトはA1～特定の範囲のみ選択というものばかりで・・・。 稚拙ながら途中まで書いたコードです。 (1)Sub B5から最終セルの選択とコピー() (2)Range("B65536").End(xlUp).Offset(0, 11).Select (3)Range("B5", ※).Copy (4)End Sub ※に(2)で取得した最終セルを代入したいのですが方法が分からず・・・。 ここでまず躓いてしまっています。 どうかお知恵を貸して下さい。よろしくお願いします。

  • VBA　別シートの最終行に追記

    ExcelのSheet1で作成した表の一部項目を、Sheet2に一覧表としてまとめたいのです。 例えばSheet1にアンケート項目のような入力されていて、毎日使いまわします。 セルA1：　訪問日→固定　　　　　セルB1：　（日付）→更新 セルA3：　お客様指名→固定　　セルB3：　（氏名）→更新 使いまわすので、1度入力されたものは、Sheet2に一覧表として転記しておきたいのです。Sheet2の一覧表の最終行をみつけて追記していきたいです。 書いてみたのは以下の通り。 Private Sub 登録ボタン_Click() Dim SH1 As Worksheet, SH2 As Worksheet Dim GYO As Long Set SH1 = ThisWorkbook.Worksheets("回答内容") Set SH2 = ThisWorkbook.Worksheets("情報シート") ' Sheet2の最終行を取得 GYO = SH2.Range("$A$65536").End(xlUp).Row ' 最終行の次行を取得 If SH2.Cells(GYO, 1).Value <> "" Then GYO = GYO + 1 　' 現在の収容位置の下に転記 SH2.Cells(GYO, 1).Resize(1, 20).Value = SH1.Range("$c$2:$D$10").Value With SH1 .Range("A3").Copy Destination:=SH2.Range("A2") .Range("B3").Copy Destination:=SH2.Range("B2") End With End Sub 項目は飛び飛びのセルに入力されていて、それらをまとめて一覧表の1行にまとめたいと思っています。 ここでは例としてSheet1[A3][B3]セルをSheet2へ転記していますが、項目はもっといっぱいあります。 記載したコードで実行すると、1回目は転記されますが、2回目以降が追記されていきません。 ' 現在の収容位置の下に転記 のところに問題があると思っています。 全くの初心者が、コードを書くのには無理があると思いますが、どなたか教えていただけないでしょうか。宜しくお願いします。

  • マクロで、カット→”値”だけをペーストで、

    セル：B2 は、1（数字） Ｃ2は、2（数字） Ｄ2は、（式）＝B2+Ｃ2　が入っています。すなわち、3　です。 Ｂ2から下にある数行をカットして”値”だけ別表の下に貼り付けようとしますが、 (　Ｃopy　→　ペーストなら下記のマクロで出来ますが　) Sub aaa() With ActiveSheet .Range("B2", .Range("D65536").End(xlUp)).Copy _ Destination:=Worksheets("Sheet2").Range("Ｆ65536").End(xlUp).Offset(1, 0) End With End Sub Ｃopy を Ｃut にすると、動きません。 どこがミスしているかを教えていただきたくお願いします。 マクロ初心者です。

  • シート間の値の貼り付け。　スマートにしたい。

    こんばんは。 エクセルのシート１の[d7]から シート2の[最終行]からカウントした数分（下の場合はシート1[d7]の値をc列に3行分）貼り付けるには下記のコードでOKと伺ったのですが、 この作業を何度も繰り返しさせているうちに動作が重くなってしまったような気がするのでが、シート１の[b2](貼り付け時に日付)[b3]（VLOOKUPの計算式が入っているので値のみ）[b4]（時刻）の形式でシート２のそれぞれ、隣接するd,e,l列に3行づつ貼り付けたいのですが、 何か方法は、ありますでしょうか。（それぞれ貼り付けたい形式も異なります。） n=3 Worksheets("Sheet1").Range("d7").Copy _ Destination:=Worksheets("Sheet2").Range("c65536").End(xlUp).Offset(1, 0).Resize(n, 1) ↓動作確認ができなくなってしまったので、試していないのですが、 上の式の値のみ貼り付け方法は下記でよいのでしょうか。 '値のみ貼り付け Set WWR1 = Worksheets("Sheet1").Range("c7") Set WWR2 = Worksheets("月度集計").Range("c65536").End(xlUp).Offset(1, 0).Resize(n, 1) WWR2.Value = WWR1.Value 宜しくお願い致します。

  • ＶＢＡ　別シートからコピー貼付け（複数列）

    別シートからコピー貼付け（複数列）をしたいのですが，同一シートからのコピー貼付けはネットから以下のマクロでできました。 しかし，別シートsheet1からsheet2ヘコピーで修正しましたが，「アプリケーション定義またはオブジェクト定義のエラーです。」となります。どなたかご教授よろしくお願いします。 修正したマクロ Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Sheets("sheet2").Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Sheets("sheet1").Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub 参考としたマクロ http://www.excel.studio-kazu.jp/kw/20041208152106.html Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub

  • 【VBA】Ifで他シートから検索しコピーする

    Excel vbaについて教えてください。 自分で作成したコードが、うまく動かず悩んでいます。 ●作りたいもの Sheet3のA列にある数字を検索値とし、 Sheet1のA列を検索し、合致する行のB列～最終列までコピーし、 Sheet3のB列から貼付する。 ※Sheet1にある列数（項目数）は不定です ●作成したマクロ Sub test() Dim sh1 As WorkSheet Dim sh2 As WorkSheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet3") d = sh2.Range("A1").End(xlDown).Row 'Sheet3検索値のA列のデータの最終行 g = sh1.Range("B1").End(xlToRight).Column 'Sheet1の最終列 k = 2 For i = 2 To d 　　 'Sheet3最終行まで If sh1.Cells( i & "A") = sh2.Cells( 1,"A")　Then '条件）Sheet1とSheet3のA列が合致 For j = 2 To g　　　　　　　　　　　　　　　　　　　　　 'Sheet1の最終列まで sh2.Cells( k , j ) = sh1.Cells( i , j ) 'Sheet1のB行から最終列をコピーしSheet3へ貼付 Next j End If Next End Sub いろいろ直していたのですが、Set sh2 = Worksheets("Sheet3")で「インデックスが有効範囲にありません」（同じブック内に同名シートがあるのに？）とエラーが出たり、 また、B行から最終列までコピーする際の範囲指定についてもよくわからず、 もっと他に良い方法が無いものかとお手上げ状態です。 どうぞ宜しくお願いいたします。

  • 決まったシートだけコピーして一つのシートにまとめる

    お世話になります。 http://okwave.jp/qa/q8216220.html で質問させていただいたVBAをこねくり回してみたのですが、「インデックスが有効範囲にありません」というエラーがでて進まなくなってしまいました。 Sub 特定のシートだけコピーと貼り付け() Dim k As Long, endRow As Long, wS As Worksheet Dim P As Variant P = Array("全", , "A", "B", "C", "D", "E", "F", "G", "H", "I") '↑コピーしたいシート名一覧 Set wS = Worksheets("まとめ") endRow = wS.cells(Rows.Count, "B").End(xlUp).Row If endRow > 4 Then Range(wS.cells(5, "B"), wS.cells(endRow, "M")).ClearContents End If For k = LBound(P) To UBound(P) ☆If Worksheets(k).Name <> "まとめ" Then 'ワークシート名が"まとめ"のとき endRow = Worksheets(P).cells(Rows.Count, "B").End(xlUp).Row 'P＝Arrayで指定しているシートのセルで If endRow > 4 Then '4行目より下を Range(Worksheets(P).cells(5, "B"), Worksheets(P).cells(endRow, "M")).Copy _ wS.cells(Rows.Count, "B").End(xlUp).Offset(1) 'B5からM列の任意のデータが入っているセルまでコピーして"まとめ"シートに貼り付け End If '繰り返す End If '繰り返す Next k '次のシートへ End Sub 自分で分かるようにコメントを付けています。 ☆のついているところで、「インデックスが有効範囲にありません」と出ます。 指定したシートに"まとめ"を追加してみてもやはり同じでした。 調べたところ、「インデックスが～」というのはVBA中の範囲にないものを指定しているからだ、ということなのですが・・・。 お知恵を貸して下さい。よろしくお願いします。

  • 複数の列を繋げてＡ列に入れたい　ＶＢＡ

    aaa aaa　　bbb aaa　　bbb　　ccc aaa (A列にaaa、B列にbbb、C列にcccが入ってます) と言うデータがあるのですが 全てＡ列に入れて aaa aaabbb aaabbbccc aaa としたいです。 ・最終列は必ずしもＣではないのです。（Dの場合もEの場合もある） ・最終行も変化します。 Sub 分かれてる列を繋げる() Dim Col As Long Dim Row As Long For Row = 1 To Range("a65536").End(xlUp).Row 　　For Col = 1 To Cells(Row, 256).End(xlToLeft).Column 　　　Cells(Row, 1) = Cells(Row, 1) & Cells(Row, 2) & Cells(Row, 3) 　　 Next Col Next Row End Sub をやってみましたが、 aaa aaabbbbbb aaabbbcccbbbcccbbbccc aaa となってしまい、 欲しい結果とは違くなってしまいます。

  • オートフィルター後の見出し以外をコピー

    お世話になっております。Excel2003を使ってます。 オートフィルター後の、見出し以外をコピーしようと考えています。 現在は With　ThisWorkbook.Worksheets("テスト") .Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select '可視セルの選択 Selection.Copy '可視セルコピー ThisWorkbook.Worksheets("フィルタ用").Range("A" & m).PasteSpecial 'A列に貼り付け！ Excel.Application.CutCopyMode = False 'クリップボードの内容クリア End with この内容で上手くいっていましたが、 見出し+1行しかない場合、 全範囲選択になってしまい、上手くいかない状況です。 どうやったら、見出し以外のB列をコピーできるのでしょうか？ Offset　とか、　Resize　を使えばいけるのでしょうか…？ 見出し以外の行、 B列、C列、D列　F列　を　「TEST」シートにコピーしたいです。 With ThisWorkbook.Worksheets("テスト").Range("A1").CurrentRegion .Offset(1, 1).Resize(.Rows.Count - 1, 3).Copy _ Destination:=Thisworkbook.worksheets("TEST").Range("A" & m) .Offset(1, 4).Resize(.Rows.Count - 1, 1).Copy _ Destination:=Thisworkbook.worksheets("TEST").Range("D" & m) End With 考えたのですが、良く分からなくなってしまいました。 回答をお願い致します！

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する