プロが教える店舗&オフィスのセキュリティ対策術

シート1、シート2ともA列からG列までが結合セルになっています。
シート1のG列のAAが含まれる行をシート2に図のように転記するVBAを教えてください。

「VBAで結合セルを転記する法を教えてくだ」の質問画像

質問者からの補足コメント

  • WindFaller 様 GooUserラック 様
    お礼が遅れてすみませんでした。
    私の質問の仕方が悪くてすみません。
    ご両者の回答で質問のファイルは思い通りに動きました。
    実際のファイルは1行目にタイトル行があり、データは3行目からになっていて、表示の右側にもあと数列のデータが入っています。
    ご両者の構文を手直しして試みましたが、実力不足で思うように動かすことができませんでした。
    データは下図のようになっており、I列以降にも何列かのデータが入っています。

    「VBAで結合セルを転記する法を教えてくだ」の補足画像1
      補足日時:2017/02/19 08:56
gooドクター

A 回答 (6件)

以下のように修正してください。


------------------------------------------------------------------------------
Sub Sample()
Dim 元行 As Long
Dim 先行 As Long
Sheets("Sheet2").Select
Range(Cells(3, 1), Cells(Rows.Count, Columns.Count)).ClearContents
Sheets("Sheet1").Select
先行 = 3
For 元行 = 3 To Cells(Rows.Count, 7).End(xlUp).Row Step 2
If Cells(元行, 7).Value = "AA" Then
Range(Cells(元行, 1), Cells(元行 + 1, Columns.Count)).Copy
Sheets("Sheet2").Select
Cells(先行, 1).Activate
ActiveSheet.Paste
先行 = 先行 + 2
Sheets("Sheet1").Select
End If
Next
Application.CutCopyMode = False
End Sub
------------------------------------------------------------------------------
    • good
    • 0
この回答へのお礼

GooUserラック 様
回答ありがとうございました。
お陰様で思い通りの動作ができる表ができました。

お礼日時:2017/02/19 16:49

No.5 の追加です。



ループなどを使って範囲指定する時は「Range("左上列記号左上行番号:右下列記号右下行番号")」ではなく「Range(Cells(左上行番号,左上列番号),Cells(右下行番号,右下列番号))」を良く使います。こちらも列を数字で指定できるのでループが簡単に出来るからです。
    • good
    • 0

回答ではありません。

No.3とNo.4 の一部解説です。

ループなどを使ってセルを指定する時は「Range("列記号行番号")」ではなく「Cells(行番号,列番号)」を良く使います。列を数字で指定できるのでループが簡単に出来るからです。
ちなみに「オプション」「数式」「数式の処理」「R1C1 参照形式を使用する」にチェックを入れると列記号ではなく列番号で表示されるようになります。(プログラムを組む時に変えたままにして怒られた事があります)

「Rows.Count」はエクセルの最終行番号です。
「Columns.Count」はエクセルの最終列番号です。
エクセルのバージョンに合わせて変わってくれるので2003以前とか2007以降とか気にせず使えます。

「Cells(Rows.Count, 列番号).End(xlUp).Row」は列番号で指定された列の値の入っている最終行になります。注意点は、列に何もない時も1行目にだけ値が入っている時も「1」になります。
    • good
    • 0

とりあえずこんな形で良いのでは?


------------------------------------------------------------------------------
Sub Sample()
Dim 元行 As Long
Dim 先行 As Long
Sheets("Sheet2").Select
Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).ClearContents
Sheets("Sheet1").Select
先行 = 2
For 元行 = 2 To Cells(Rows.Count, 7).End(xlUp).Row Step 2
If Cells(元行, 7).Value = "AA" Then
Range(Cells(元行, 1), Cells(元行 + 1, Columns.Count)).Copy
Sheets("Sheet2").Select
Cells(先行, 1).Activate
ActiveSheet.Paste
先行 = 先行 + 2
Sheets("Sheet1").Select
End If
Next
Application.CutCopyMode = False
End Sub
------------------------------------------------------------------------------
    • good
    • 0

マクロなら、この程度で良いかと思います。



'//標準モジュール
Sub MergeCellsCopy()
 Dim c, k As Long
 Dim sh1 As Worksheet, sh2 As Worksheet
 Set sh1 = Worksheets("Sheet1")
 Set sh2 = Worksheets("Sheet2")
 k = 1
 Application.ScreenUpdating = False
 With sh1
  For Each c In .Range("G2", .Cells(Rows.Count, "G").End(xlUp)).Cells
   If c.Value Like "AA" Then
    c.EntireRow(1).Resize(2, 7).Copy sh2.Cells(2 + (k - 1) * 2, 1)
    k = k + 1
   End If
  Next
 End With
 Application.ScreenUpdating = True
End Sub
    • good
    • 0


抽出のこと?
フィルター使えば?
https://kokodane.com/2013_waza_053.htm
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング