エクセル マクロの２変数処理

質問

10年以上前にちょっとかじった素人です。使っているテキスト本が古い様です。
以下のようなエクセル表（例題）です。
もともとの表の作り方に問題があるのですが、変更できません。

A 列＝欄番,　B列=識別CodeB、C列＝識別CodeC、D列＝店名、E列＝地域、F列＝商品名、G列＝売り単価、H＝仕入れ単価、I＝差益
注）　I=差益は合計欄のみに入力されております。

A、 B　、C　、D　　　　、 E　、 F　　　、 G　、 H　、 I　、
１、B1、C1、関東商店、関東、はさみ、１００、９０、
２、　　、　、　　　　　　、　　　、クリップ　１００、９０
３、　　　　　　　　　　　　　　　　（合計）　２００、１８０、２０
４、B2,C2,関西商店、関西、　ノート、１００、９０、
５、　　　　　　　　　　　　　　　　クリップ　１００、９０、
６、　　　　　　　　　　　　　　　　消しゴム１００、９０、
７、　　　　　　　　　　　　　　　　（合計）　３００、２７０、３０
８、B3、C3、沖縄商店、沖縄、ペン　　　１００、９０
９、　　　　　　　　　　　　　　　　（合計）　１００、９０、１０

欄番１は6行目から始まっております。
（合計）の文字は入力されておらず空欄です。
商品の数量は不定です。
差益は合計欄に合計が入れてあり、個々にはありません。

B列のコードの有無を条件にDとEの店名、地域を（合計）欄のD,とEに貼り付けたいのですが、
行数が不定なので合計金額の有無を条件にD,とEに貼り付けようとしたところ、コピーまでできましたが貼り付けができません。解決方法を教えてください。
よろしくお願いします。

注）Selection.PasteのOperation:=からは手打ちで足しました。

Sub CopyPaste()

Dim n As Long
Dim m As Long

Dim jbNOM As Variant
Dim prAMT As Variant

n = 6
m = 7

Do While Range("A" & n).Value <> ""

jbNOM = Range("B" & n).Value
prAMT = Range("I" & m).Value

If jbNOM <> "" Then
Range("D" & n & ":E" & n).Select
Selection.Copy

If prAMT <> 0 Or IsNull(prAMT) Then
Range("D" & m & ":E" & m).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=Fales, Transpose:=Fales
Else
m = m + 1
End If

Else
n = n + 1
End If

Loop

MsgBox "Complete"

End Sub

回答No.1

FEX2053

なんか難しく考えてる気がしますが・・・。

私ならこう作ります。

Sub test()
Range("F7").Select
TENMEI = Selection.Offset(0, -1).Value
CHIIKI = Selection.Offset(0, -2).Value
Do While Selection.Value <> ""
If Selection.Value = "（合計）" Then
Selection.Offset(0, -1).Value = TENMEI
Selection.Offset(0, -2).Value = CHIIKI
TENMEI = Selection.Offset(1, -1).Value
CHIIKI = Selection.Offset(1, -2).Value
End If
Selection.Offset(1).Select
Loop
End Sub

事前に店名と地域を保存しておいて、セルF7からスタート。

「（合計）」が来るまで一つずつ下のセルをチェックして、
見つかったら、事前に保管しておいた店名・地域を所定の
場所に貼りつけ、貼りつけた場所の一つ下の店名・地域
を改めて保管。

F列が空白になるまで処理を続行。

これでいいんじゃないかと。

お礼

FEX2053さん
こんにちは。
早速のご教示ありがとうございます。
こんなに簡単なマクロだとは、思いませんでした。
まだまだ勉強不足でした。
ありがとうございます。