エクセルVBAコピーしたセルを順番に張り付ける方法

このQ&Aのポイント
  • 質問者は、VBAを使ってエクセルのセルをコピーし、別のシートに張り付ける方法について質問しています。
  • 質問者は、for文を使用した処理方法が分からないため、助けを求めています。具体的には、A列からB列にテキストがある場合に、B列のセルが入力されている行全体を別のシートにコピーして貼り付けたいと考えています。
  • 質問者は、コピーの部分まではうまく実装できたが、貼り付ける際に行が上書きされてしまう問題が発生していると述べています。また、すでに貼り付けられた行がある場合は、その下に新たに行を追加して貼り付ける方法を知りたいとしています。
回答を見る
  • ベストアンサー

エクセルVBAコピーしたセルを順番に張り付ける方法

おはようございます。 for文の処理方法がわからないので質問します。 やりたいこと 例・sheet2・sheet2・sheet4・・・と A~B列のセルに文字が有る場合 B列のセルに文字が有れば その行全体をコピーして 【貼り付け】シートに張り付けたいのですが 私の考えたコードだと コピーまではうまくできるのですが 【貼り付け】シートに行全体を張り付ける際 行を上書きされてしまいます。 (sheet2の行を張り付けたら 次にsheet3の行を貼り付けシートに上書きしてしまう) このような上書きをされずに すでに【貼り付け】シートにコピーされたものが有る場合 一つ下の行に貼り付けって出来ないでしょうか? コードを下記に記載します。 すいませんがコードを書いて頂けると助かります。 宜しくお願い致します。 追記:【貼り付け】シートは一番左端にあります。 Sub test() Dim b As Variant Dim i As Long Dim io As Integer Const  AAA  As String = "" Set b = Worksheets("貼り付け") For i = 1 To 100 For io = 2 To ThisWorkbook.Worksheets.Count If WorksheetFunction.CountIf(Worksheets(io).Rows(i), "") > 0 Then  Worksheets(io).Rows(i).Copy   b.Rows(i).Offset(1, 0).PasteSpecial (xlPasteAll)’ここの貼り付け方が間違ってますよね・・・ End If Next Next End Sub

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

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.2

>B列のセルに文字が有れば >その行全体をコピーして >【貼り付け】シートに張り付けたいのですが 参考に Sub test() Dim i As Long Dim io As Integer For io = 2 To Worksheets.Count For i = 1 To 100 With Worksheets("貼り付け") If Worksheets(io).Cells(i, "B").Value <> "" Then Worksheets(io).Rows(i).Copy .Rows(.Cells(Rows.Count, "B").End(xlUp).Row + 1) End If End With Next Next End Sub

その他の回答 (1)

  • SI299792
  • ベストアンサー率48% (713/1474)
回答No.1

説明とプログラムが違っているのですが。 プログラムでは、B列を参照していません。 説明を信じてB列に文字がある場合のみ行コピーをするなら Option Explicit ' Sub Macro1()   Dim Sheet As Integer   Dim I As Worksheet   Dim RInp As Long   Dim ROut As Long '   Sheets(1).Select   Cells.ClearContents   Application.ScreenUpdating = False '   For Sheet = 2 To Sheets.Count     Set I = Sheets(Sheet) '     For RInp = 1 To I.Cells(Rows.Count, "B").End(xlUp).Row       If I.Cells(RInp, "B") > "" Then         ROut = ROut + 1         Rows(ROut) = I.Rows(RInp).Value       End If   Next RInp, Sheet End Sub オートフィルターで絞って1度にコピーする方法もありますが、1行目からなので今回は使っていません。 違っていたら補足に書いて下さい。

関連するQ&A

  • エクセルマクロでセルのコピー

    困ってしまったので質問させてください Sub 一定秒おきに実行() Dim i As Integer  For i = 1 To 10   Application.Wait Now() + TimeValue("00:00:10")  コピーして別のシートに貼り付ける Next End Sub ---------------------------------- Sub コピーして別のシートに貼り付ける() Worksheets("sheet1").Activate Range("A1:G1").Copy ActiveSheet.Paste Destination:=Worksheets("sheet").Range("??") End Sub ----------------------------------- 以上のようなコードがありますが Sheet1のA1:G1を10秒おきにSheet2の1行、2行、3行 と順番にコピーする Sub コピーして別のシートに貼り付ける() のコードを教えてください よろしくお願いいたします

  • 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にはどのようなプログラムを入れればいいでしょうか?

  • コピー後に値のみ貼り付け エクセル、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

  • VBA 任意のシートからコピーを始める。

    教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i

  • VBA シート間の単一セルから結合セルへのコピー

    マクロについてご教授をお願いします。 ◆実現したい事 2枚のシート(XとY)が存在します。 コピー元:Xシート          コピー先:Yシート    B列                    B列 1行 商品1   コピペ→     1~3行結合 商品1  2行 商品2   コピペ→     4~5行結合 商品2 3行 商品3   コピペ→     6~8行結合 商品3   ・                    ・   ・                    ・   ・                    ・  最終行                  最終行 XシートのB列に1行ずつ、商品名が羅列されています。 YシートのB列には、3行結合(B1:B3)、(B4:B6)、(B7:B9)・・・空白セルがあります。 Xシートの商品名をYシートの結合セルにマクロを使って処理したいです。 ◆試した事 (1)結合を解除し、XからYへ範囲コピーしたが、YのB列に再び、商品毎に2行追加し、結合  2行追加する方法がわからず断念 (2).valueでXシートB1 = YシートB1を試みるができない ◆ここで詰まってます>< Dim X As Worksheet Dim Y As Worksheet Dim 最終行1 As Long Dim 最終行2 As Long Dim cp1 As Long・・・・Yシート行変数 Dim cp2 As Long・・・・Xシート行変数 Set X = Worksheets(1) Set Y = Worksheets(2) 最終行1 = Cells(Rows.Count, 2).End(xlDown).row 最終行2 = Cells(Rows.Count, 2).End(xlDown).row For cp1 = 1 To 最終行1 For cp2 = 1 To 最終行2 Step 3 sh1.Cells(cp1, 2).Copy Destination:= sh2.Cells(cp2, 2) Next Next みたいな感じにできればと、Copyを.valueなどにしてみたりと試してみましたが、 なかなかうまくいかず、3日くらい悩んでいます。 シンプルにやりたいのですが、なにか良い方法などあれば、 ご教授のほどお願い致します><

  • VBA Next For でのコピペについて

    EXCEL VBA初心者です。 AシートEW44からGD44までをコピーしてBというシートの最終行へコピーしたいです。 今下記のように組んでいるのですが、うまく作動しません。 Private Sub CommandButton1_Click() Dim i As Integer For i = 153 To 186 row1 = Worksheets("B").Cells(Rows.Count, 27).End(xlUp).Row Worksheets("A").Cells(i, 44).Value = Worksheets("B").Cells(row1 + 1, 27).Value Next i End Sub アドバイスいただけませんでしょうか。

  • ExcelのVBAでコピーのやり方

    シート1のAL列の3行目以降の中から0以外の 値が入っているAJ列~AN列の行を全てコピーして、 シート2のB列~F列に貼り付けたいです。 シート2のB列~F列の7行目から下にコピーした値を入れていきたく、 値が入っていたらその次の行に貼り付けたいです。 例えば、7行目~15行目まで値が入っていたら、16行目から貼り付けるようにしたいです。↓のように書いてみたのですが、 コピーしている状態になるだけで、シート2の方へ貼り付けができない状態です。 また、オブジェクトが必要ですと表示が出ます。 どこをどうなおしたらいいでしょうか。 文章がわかりにくく申し訳ありません。 回答よろしくお願いいたします。 sub 値をコピー() Dim rTargetRange As Range, ii As Long Set rTargetRange = Nothing For ii = 4 To Cells(Rows.CountLarge, "AL").End(xlUp).Row If (Cells(ii, "AL").Value <> 0) Then If (rTargetRange Is Nothing) Then Set rTargetRange = Cells(ii, "AJ").Resize(, 5) Else Set rTargetRange = Application.Union(rTargetRange, Cells(ii, "AJ").Resize(, 5)) End If End If Next With Worksheets("sheet2") With .Cells(.Rows.CountLarge, "B").End(xlUp) If (.Row = 1 And .Value = "") Then rTargetRange.Copy .Offset(0) Else rTargetRange.Copy .Offset(1) End If End With End With End Sub また、↓のような違ったコードも試しましたが、 うまくいきませんでした。 N=Sheet2.Cells(Rows.CountLarge, "AL").End(xlUp).Row+1 SHEET1.SELECT For ii = 4 To Cells(Rows.CountLarge, "AL").End(xlUp).Row If Cells(ii, "AL").Valu e <> 0 Then RANGE("AJ" & ii & ":AN" & ii).COPY SHEET2.RANGE("B" & N) N=N+1 END IF NEXT

  • VBA 100行ごとに列を変更してコピーする。

    Winは7、Excelは2013を使用しています。 A列とB列のデータを100行毎に列を変えてコピーしたいと思っています。 (画像参照願います。) それで、別シートにコピペするサンプルコードを見つけたのですが、 同シート内でする様に変更する知識がなく、苦戦しています。 申し訳ありませんが、ご教示願います。 別シートにコピペするサンプルコード Sub データを100行ごとに分割する() Dim シート As Worksheet, 元 As Worksheet '元は元データのあるシート Dim 総行数 As Long, 回数 As Long, i As Long, 開始行 As Long Const コピー行 = 100 Set 元 = ActiveSheet '変数の元をActiveSheetにセットする 総行数 = 元.UsedRange.Rows.Count 回数 = Int(総行数 / コピー行) + IIf(総行数 Mod コピー行 > 0, 1, 0) 開始行 = 1 For i = 1 To 回数 Set シート = Sheets.Add シート.Name = 開始行 & "~" & 開始行 + コピー行 - 1 元.Rows(開始行 & ":" & 開始行 + コピー行 - 1).Copy シート.Range("A1") Columns("A:F").AutoFit 開始行 = 開始行 + コピー行 Next i End Sub

  • ExcelにおけるVBAで、データの振り分けをしたい

    Sub a() Dim i As Long Dim s As Long Dim b As Worksheet Dim c As Worksheet Dim maxi As Long Dim maxs As Long Application.ScreenUpdating = False With ThisWorkbook Set b = .Worksheets("bbb") Set c = .Worksheets("ccc") End With maxi = b.Range("A1").CurrentRegion.Rows.Count maxs = c.Range("A1").CurrentRegion.Rows.Count For i = maxi To 2 Step -1 For s = maxs To 2 Step -1 If c.Cells(s, 1) = b.Cells(i, 1) And c.Cells(s, 2) = b.Cells(i, 2) Then c.Cells(s, 14) = b.Cells(i, 3) End If Next s Next i Application.ScreenUpdating = True End Sub ワークシートcとワークシートbの1列目と2列目が一致したときにだけ、cの14列目にbの3列目のデータを代入したく思い、以上のようなコードを書きましたが、重くて終わる様子がありません。 ・そもそもあっているのか、あっていないならどこを修正すればよいか ・早く終わるようにするにはどうしたらいいか アドバイスをよろしくお願いします。

専門家に質問してみよう