ExcelVBAでの複数ファイルからのデータ集約

Question

前提・実現したいこと

ExcelVBAで複数のExcelファイルのデータを一つのExcelファイルに集約しようとしています。

以下の画像を参考として用意しました。
![
実際のファイルはこの下に6000行くらい同じ法則性でデータが並んでいます。
この転記元のファイルにあるA列のユニークコードを検索して
目的のコードの集計区分Aのデータを引き抜いて転記先ファイルにペーストしたいというのが望みです。
引き抜きたいデータは「対象コードの集計区分Aのひとつ右のセルから始まる1ヶ月分のデータ」となります。
今回このファイルにある対象コードは数千あるうちの「111111115」のひとつだけで、
ユニークコードなのでダブりはありません。

検索してデータ部分のセルの頭までアクティブセルを持っていくことは出来たのですが、
その先の2/1から月末までのデータを選択してコピーするところで詰まってしまいました。
以下に現状のコードを記載するのでお力添えください。

該当のソースコード

Option Explicit

Sub test()

    Workbooks.Open "C:\Users～～～"
    Sheets(1).Select
    
    Dim rng As Range

    Set rng = Range("A:A").Find("111111115")

    If rng Is Nothing Then
    MsgBox "none"
  Else
    rng.Offset(0, 3).Select
  End If

    
End Sub

試したこと

selectまではさせたので後はそのセルをRangeで指定して範囲を右に伸ばせばよかろうと
思ったのですが、どうやってこのセルを指定させればよいのかで詰まりました。

Answer 1

データのある最後の列まで選択するには、キーボート操作では、[Shift] + [Ctrl] + [→] でできます。
これを「マクロの記録」で記録すれば、コードはすぐにわかります。下記のようなコードができあがると思います。

    Range("D2").Select
    Range(Selection, Selection.End(xlToRight)).Select

これを参考にすれば、

    rng.Offset(0, 3).Select
    Range(Selection, Selection.End(xlToRight)).Select

で目的のコードはできあがります。

蛇足

このように「マクロの記録」を使えば、手作業でできることはたいていマクロにできます。
できたマクロのコードの意味をヘルプ等で調べれば、そのうち「マクロの記録」に頼らなくてもコードが書けるようになります。

ただし、「マクロの記録」は手作業をコードに変換しただけなので、効率的でない冗長なコードになることが多いです。
例えば、今回の場合、手作業だと、範囲選択してコピー、目的のセル範囲に移動して貼り付け、という処理になりますので、「マクロの記録」でできあがるコードは数行のものになります。 ところが、VBAなら、Copyメソッド１行で同じことができます。 あるいは、代入という操作でも１行でできます。

下記のリンク先を参考に、「マクロの記録」のコードを書き換えることもチャレンジしてみてください。

Office TANAKA - Excel VBA講座：セルの操作[セルのコピー]

このようなことを繰り返すことで確実にスキルアップできます。

私ならこうする

できれば、自身で考えてもらえればスキルアップになるかと、あえてリンク先だけの紹介に止めましたが、せっかくなので、コード例を提示しておきます。

Option Explicit '変数宣言強制

Sub Test()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
        
        
    Set wb1 = Workbooks.Open("C:\Users～～～")  '転記元ファイル
    Set ws1 = wb1.Worksheets(1)

    Set wb2 = Workbooks.Open("C:\Users～～～")  '転記先ファイル
    Set ws2 = wb2.Worksheets(1)
        
    Set rng1 = ws1.Range("A:A").Find("111111115") '該当データ検索
    
    If rng1 Is Nothing Then
        MsgBox "none"
    Else
        Set rng1 = ws1.Range(rng1.Offset(0, 3), rng1.End(xlToRight)) 'コピー元範囲
        Set rng2 = ws2.Range("A1").Resize(rng1.Rows.Count, rng1.Columns.Count) 'コピー先範囲

        '値のみコピーの場合、下記の代入操作が、
        '高速かつクリップポードを使わずにコピーできるのでお勧め
        rng2.Value = rng1.Value
      
    End If

End Sub

• Option Explicit は宣言しておく。変数のスペルミスやバグの発生の抑制になる。
• 各オブジェクトを変数に代入して利用すると見通しのよいコードになる。
• 値のみのコピーなら代入処理がシンプルかつ高速。
• 不要な Select はしない。

Comments

[sobameshi]

回答ありがとうございます。
別の方の回答を参考にさせていただきました。

Answer 2

既にひとつの回答は出てますが、私からも回答します。

やってることは他の回答と同じです。
範囲を選択するところまで。

Set Rng = Range("A:A").Find("111111115")
Range(Cells(Rng.Row, 4), Cells(Rng.Row, Cells(Rng.Row, 4).End(xlToRight).Column)).Select

ただし、範囲をSelectとするというやりかたは膨大な量のデータを処理する場合あまり効率がよいとはいえません。
範囲が決まったらそのままコピーすることが可能です。
次のようにSelectの代わりにCopyメソッドを使って、直接貼り付け先を指定すると良いです。

' 1番目のワークシートのA1セルに貼り付ける
Range(Cells(Rng.Row, 4), Cells(Rng.Row, Cells(Rng.Row, 4).End(xlToRight).Column)).Copy Worksheets(1).Cells(1,1)

Comments

[sobameshi]

回答ありがとうございます。
なるほど、こうすればスマートに書けるわけですね。
今回は別ファイルに転記する予定だったので以下のようにとりあえず書きかえてみました。
無事に転記が出来たのでこれで解決しました。
これもまだスマートに出来そうではありますが今後の課題として勉強してみます。

```VBA
Set rng = Range("A:A").Find("111111115")
Range(Cells(rng.Row, 4), Cells(rng.Row, Cells(rng.Row, 4).End(xlToRight).Column)).Copy

Workbooks("転記先.xlsm").Activate
Range("D4").PasteSpecial xlPasteValues
```

[ttyp03]

一応できているようですが、これだとアクティブブックを切り替えるような処理が無駄になってしまいます。
Range(Cells(rng.Row, 4), Cells(rng.Row, Cells(rng.Row, 4).End(xlToRight).Column)).Copy Workbooks("転記先.xlsm").Worksheets(1).Range("D4")
と書けると思います（Worksheets(1)は適宜修正してください）。
色々と試してみてください。

[sobameshi]

試してみたところ書式もそのまま転記してしまっていたため、
アクティブ化させて値貼り付けの処理は今の技術だとやはり必要そうです。
.valueあたりに何かしらヒントがありそうなので引き続き試してみます。
いろいろとありがとうございます。

[ttyp03]

値のみとなると一文で書くのは無理っぽいですね。
こんな感じでしょうかね。
Set rng = Range("A:A").Find("111111115")
Range(Cells(rng.Row, 4), Cells(rng.Row, Cells(rng.Row, 4).End(xlToRight).Column)).Copy
Workbooks("転記先.xlsm").ActiveSheet.Range("D4").PasteSpecial xlPasteValues

[sobameshi]

やはりそうですか。
すいません、こちらの作業では当然のようにやっていたので
きちんと説明することを失念していました。
3行目参考にさせていただきます。

[hatena19]

値のみのコピーなら代入処理が１文で記述できて、かつ高速です。

Workbooks("転記先.xlsm").ActiveSheet.Range("D4").Resize(,rng.End(xlToRight).Column - 3).Value = Range(rng.Offset(0, 3), rng.End(xlToRight)).Value

私の回答のサンプルコードもご参考に。

Answer 3

データの右端を特定したい、ということですよね？
UsedRangeプロパティが使えると思います。
すみません、確証はないです。。。