売上データから請求書に転記、月別、顧客別に抽出

マクロ講座動画編 37回

動画でExcel　売上データから請求書に転記、月別、顧客別に抽出

売上データから請求書に転記、月別、顧客別に抽出

マクロ講座の37回はこの売り上げ表を使って、得意先ごとに抽出したデータを請求書に貼り付けるというコードを考えていきたいと思います。
前回の３６回において、オートフィルで抽出するという方法を紹介しましたので、どうやって抽出するかという方法は、オートフィルメソッドを使えばいいんだということがお分かりかと思います。

マクロ動画　売上データから請求書に転記、月別、顧客別に抽出

filename

売上データから請求書に転記

この売上データ得意先ごとに抽出します。
そのデータをこちらの請求書に転記していきます。
今こちらに抽出した、「むつみという株式会社」のデータが入ってますね。売り上げの抽出月は10月分ということで抽出されたデータが転記され、請求額が表示されています。
コードの前提としての変数を説明します。
Sheet1とSheet2ですが、コード名としてのオブジェクト名を変更しています。
VBAコードで使うオブジェクト名を sh_uriageとsh_seikyuuという名前に変更しています。
その方が、使いやすいからです。
Set ws = sh_uriage
Set sh1 = sh_seikyuu

オートフィルターにで期間に月を設定

Set rng = ws.Range("A5").CurrentRegion　
でwsのA5セルのカレントリージョンを設定しています。これは売上シートのデータ範囲のことで、オートフィルタを設定する範囲でもあります。
次に、請求書のデータが残っているかもしれないので消去しています。
With ws　からのコードでオートフィルターを設定しています。
Field:=1　は対象範囲の１列目という意味です。
このコードで対象となる月を指定しています。
「10月の31日の2022」ということで 10月で設定しました。
rng.AutoFilter Field:=1, Operator:=xlFilterValues, _ Criteria2:=Array(1, "10/31/2022")
オートフィルターで月はどこで指定しているのかというと、Criteria2:=Array(1,
の数字の1で指定しています。
もうひとつオートフィルターを追加します。
rng.AutoFilter Field:=2, Criteria1:=.Range("H2").Value
H2には得意先名が入っています。
コードの意味は、この得意先名で２番目の列をフィルターしろということになります。

不要な列を非表示にし、見出し以外の範囲をコピーする

次に請求書には必要ない列を非表示にします。 .Columns("B:C").Hidden = True
さらに、不要なのは見出し行ですから、見出し以外の範囲をコピーするようにします。
```
.Columns("B:C").Hidden = True
.Range("A5").CurrentRegion.Resize(rng.Rows.Count - 1).Offset(1, 0).Copy
```
続いてコピーしたデータを請求書にはりつけます。
次のコードは非表示にしていたColumns("B:C")をまた再表示しています。そしてオートフィルターの設定も解除します。
```
        .Columns("B:C").Hidden = False
        .AutoFilterMode = False
    End With
```
もう最後のコードです。請求書に抽出した得意先名を入れています。今回のコードはここまでです。請求書を印刷するのは、次回の動画と解説で説明しています。
```
    sh1.Range("A4").Value = ws.Range("H2").Value
    Application.ScreenUpdating = True
    sh_seikyuu.Activate
End Sub
```

請求書に転記するコード

売上データから月別、顧客別に抽出して請求書に転記するコード

Option Explicit
'入門編３7回請求書
Dim ws As Worksheet, sh1 As Worksheet, sh2 As Worksheet
Sub 請求書作成()
    Set ws = sh_uriage
    Set sh1 = sh_seikyuu
    Dim rng As Range
    
    Set rng = ws.Range("A5").CurrentRegion
    sh1.Range("A17:E31").ClearContents
    ws.Activate
    Application.ScreenUpdating = False
    With ws
        rng.AutoFilter Field:=1, Operator:=xlFilterValues, _
            Criteria2:=Array(1, "10/31/2022")
        rng.AutoFilter Field:=2, Criteria1:=.Range("H2").Value
        .Columns("B:C").Hidden = True
        .Range("A5").CurrentRegion.Resize(rng.Rows.Count - 1).Offset(1, 0).Copy
        sh1.Range("A17").PasteSpecial Paste:=xlPasteValues

        .Columns("B:C").Hidden = False
        .AutoFilterMode = False
    End With

    sh1.Range("A4").Value = ws.Range("H2").Value
    Application.ScreenUpdating = True
    sh_seikyuu.Activate
    
End Sub