【脱エクセルVBA初心者】Copyメソッドで範囲まるごとを一発でコピペする

photo credit: Nutribullet and vitamix personal blenders next to strawberries via photopin (license)

みなさん、こんにちは！
タカハシ(@ntakahashi0505)です。

脱エクセルVBA初心者向け、請求書を自動で作る際の様々なテクニックについて連載でお伝えしています。

前回はコチラの記事です。

【脱エクセルVBA初心者】コピペはRangeが効率的なのでその範囲を見つけるプログラム

脱エクセルVBA初心者向け、請求書を自動で作る際の様々なテクニックについてシリーズ。請求データを塊つまりRangeで見つけられれば一気にコピペできるようになります。その「塊」を効率よく見つける方法です。

シートからシートへのコピペは１セルずつ、または１行ずつというのがアルゴリズムとしては簡単です。

ですが、その分処理の回数が増えてしまうので、コピペは範囲で行うのが効率が良いんですね。

前回の記事でその範囲の見つけ方について説明をさせて頂きました。

今回は、実際にその見つけた範囲について範囲単位でまるごとコピペをする方法についてお伝えしつつ、請求書作成プログラムを作り込んでいきます。

では、行ってみましょう！

前回のおさらい
Copyメソッドで範囲まるごとコピー＆ペーストをする
1. CellsでRangeオブジェクトを指定する
請求書作成プログラムを作り込む
まとめ
連載目次：【脱エクセルVBA初心者】請求書を自動で作る際のテクニック集

前回のおさらい

ではまず前回のおさらいから行きます。

まず今回対象となる請求データはこちらです。

この赤枠ごとに別々の請求書に転記していきたいというわけです。

その前準備として作ったプログラムがこちらです。

Sub wsDataRangeFind()

Dim wsData As Worksheet '「請求データ」シート
Set wsData = ThisWorkbook.Worksheets("請求データ")

Dim startRow As Long 'コピー範囲の最初の行と最終行を格納
startRow = 2

Dim i As Long
i = 2
Do While wsData.Cells(i, 1).Value <> ""

    i = i + 1
    If firstDay(wsData.Cells(i, 1).Value) <> firstDay(wsData.Cells(startRow, 1).Value) Or _
        wsData.Cells(i, 2).Value <> wsData.Cells(startRow, 2).Value Then

        Debug.Print "Start:" & startRow & ",End:" & i - 1
        startRow = i

    End If

Loop

End Sub

プログラムの流れとしては

範囲の最初の行数startRow=2
請求データの2行目から最後まで繰り返し
- startRow行と今いる行の年月が異なっている、またはstartRow行と今いる行の取引先が異なっている
  - ★イミディエイトウィンドウにstartRowと今いる行の一つ前の行数を出力

という流れになります。

今回の目的としては★のところに

それぞれの請求書ファイルを作成
作成した請求書に該当の請求データの範囲をコピペ
請求書を保存して閉じる

という処理を追加していくことになります。

ちなみに貼り付け先の請求書ひな形はこちらです。

Copyメソッドで範囲まるごとコピー＆ペーストをする

範囲をまとめてコピー＆ペーストをする場合は、Rangeオブジェクトに対してCopyメソッドを使います。

コピー元Rangeオブジェクト.Copy コピー先Rangeオブジェクト

たったこの一行でOKです！

これまで繰り返しの構文使って実現していたかも知れませんが、これで処理数が一気に減りますね。

今回の場合ですが、コピー元の範囲は

行：startRowからi-1まで
列：3列目「品目」から5列目「数量」まで

となります。

コピー元のシート、コピー先のシートのオブジェクト変数がそれぞれwsData、wsInvoiceとすると

wsData.Range(wsData.Cells(startRow, 3), wsData.Cells(i - 1, 5)).Copy wsInvoice.Range("A21")

と表現することができます。

CellsでRangeオブジェクトを指定する

コピー元範囲の指定の仕方として

Worksheetオブジェクト.Range(Worksheetオブジェクト.Cells(行A,列A), Worksheetオブジェクト.Cells(行B,列B))

という方法で指定できることに注目して下さい。

範囲の開始セルと終了セルをそれぞれCellsで指定する方法です。けっこう使いどころあるので覚えておいて下さい。

ちなみに、この文を

wsData.Range(Cells(startRow, 3), Cells(i - 1, 5)).Copy wsInvoice.Range("A21")

などとWorksheetオブジェクトを省いて書きそうになりますが、これをすると

実行時エラー’1004′:’Rangeメソッドは失敗しました: ‘_Worksheet’オブジェクト

というエラーになります。

命令文は長くなってしまいますが複数のシートを取り扱うので、どのシートの範囲なのかというのを明示するクセをつけておくと良いと思います。

請求書作成プログラムを作り込む

では、こちらの1～3ですが

それぞれの請求書ファイルを作成
作成した請求書に該当の請求データの範囲をコピペ
請求書を保存して閉じる

一気に仕上げていきましょう。

1,3に関しては以前の記事で紹介しました以下のプログラムをゴソっと使うことができます。

429 Too Many Requests

ちょっと長いですが貼っておきます。

Sub wsCopyNewBook()

    Dim wsInvoice As Worksheet '「請求書ひな形」シート

    Workbooks.Add '新規ワークブックを作成
    ThisWorkbook.Worksheets("請求書ひな形").Copy before:=ActiveWorkbook.Sheets(1) '新規ワークブックのsheet1の前にひな形をコピー

    Set wsInvoice = ActiveSheet 'コピーしたシートを変数にセット
    wsInvoice.Name = "請求書" 'シート名を変更

    Application.DisplayAlerts = False '確認メッセージをオフにする
    ActiveWorkbook.Worksheets("Sheet1").Delete 'Sheet1を削除する
    Application.DisplayAlerts = True '確認メッセージをオンにする

    Dim strFile As String '保存先フォルダパス＆ファイル名（拡張子抜き）
    strFile = ThisWorkbook.Path & "\201606請求書_株式会社ホゲホゲ御中"

    '*****PDF出力設定*****
    With wsInvoice.PageSetup

        .Zoom = False       '倍率をクリア
        .FitToPagesWide = 1 '横方向に1ページに収める
        .FitToPagesTall = 1 '縦方向に1ページに収める
        .CenterHorizontally = True                          '水平方向に中央配置
        .TopMargin = Application.CentimetersToPoints(1)     '上マージンを1cm
        .BottomMargin = Application.CentimetersToPoints(1)  '下マージンを1cm

    End With

    wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力
    ActiveWorkbook.Close savechanges:=True, Filename:=strFile & ".xlsx" 'アクティブブックを名前を付けて保存して閉じる

End Sub

このプログラムをまるっと冒頭プログラム★の箇所に挿入して、変数宣言など繰り返し処理の外で実行しても問題ないものは外に出します。

するとこのようになります。

Sub 請求書作成()

Dim wsData As Worksheet '「請求データ」シート
Set wsData = ThisWorkbook.Worksheets("請求データ")

Dim startRow As Long 'コピー範囲の最初の行と最終行を格納
startRow = 2

Dim wsInvoice As Worksheet '「請求書ひな形」シート
Dim strFile As String '保存先フォルダパス＆ファイル名（拡張子抜き）

Dim i As Long
i = 2
Do While wsData.Cells(i, 1).Value <> ""

    i = i + 1
    If firstDay(wsData.Cells(i, 1).Value) <> firstDay(wsData.Cells(startRow, 1).Value) Or _
        wsData.Cells(i, 2).Value <> wsData.Cells(startRow, 2).Value Then

        '★ここから
        Workbooks.Add '新規ワークブックを作成
        ThisWorkbook.Worksheets("請求書ひな形").Copy before:=ActiveWorkbook.Sheets(1) '新規ワークブックのsheet1の前にひな形をコピー

        Set wsInvoice = ActiveSheet 'コピーしたシートを変数にセット
        wsInvoice.Name = "請求書" 'シート名を変更

        Application.DisplayAlerts = False '確認メッセージをオフにする
        ActiveWorkbook.Worksheets("Sheet1").Delete 'Sheet1を削除する
        Application.DisplayAlerts = True '確認メッセージをオンにする

        strFile = ThisWorkbook.Path & "\" & Format(wsData.Cells(startRow, 1).Value, "YYYYMM") & "請求書_" & wsData.Cells(startRow, 2).Value & "御中"

        '*****PDF出力設定*****
        With wsInvoice.PageSetup

            .Zoom = False       '倍率をクリア
            .FitToPagesWide = 1 '横方向に1ページに収める
            .FitToPagesTall = 1 '縦方向に1ページに収める
            .CenterHorizontally = True                          '水平方向に中央配置
            .TopMargin = Application.CentimetersToPoints(1)     '上マージンを1cm
            .BottomMargin = Application.CentimetersToPoints(1)  '下マージンを1cm

        End With

        wsData.Range(wsData.Cells(startRow, 3), wsData.Cells(i - 1, 5)).Copy wsInvoice.Range("A21") '範囲をコピペ

        wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力
        ActiveWorkbook.Close savechanges:=True, Filename:=strFile & ".xlsx" 'アクティブブックを名前を付けて保存して閉じる
        '★ここまで

        startRow = i

    End If

Loop

End Sub

Copyメソッドを使って範囲でコピペする行は45行目に記述しています。