excel でグループの最後に行を追加。

こんにちは、先日教えて貰い上手くいっていましたが、チェック漏れで2行あるとうまくいきますが、1行では上手くいかなかったのを確認が漏れていました。1行でも上手く追加させたいと思います。
リストボックスで選択して最終行に1行追加する。2行あるb商品は上手くいきますが、1行のa商品は上手く追加されません。お忙しいところすいません。
Private Sub CommandButton1_Click()

Dim zaiko As String
Dim r As Range, C As Range
zaiko = ListBox1.List(ListBox1.ListIndex, 0)
With ActiveSheet
Set r = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) _
.Find(What:=zaiko, LookIn:=xlValues, LookAt:=xlWhole, After:=Cells(Rows.Count, 1).End(xlUp))
End With
If Not r Is Nothing Then
With r.End(xlDown)
.Resize(, 4).Copy
.Offset(1).Insert Shift:=xlDown
Application.CutCopyMode = False
For Each C In .Offset(1, 1).Resize(1, 3)
If Not C.HasFormula Then C.Value = ""
Next

End With
End If
End Sub

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/06/14 15:32

こういうことでしょうか。

Findの使用をやめました。

Private Sub CommandButton1_Click()
Dim zaiko As String
Dim wrow As Long
Dim maxrow As Long
Dim ws As Worksheet
Dim erow As Long
Dim C As Range
Set ws = ActiveSheet
zaiko = ListBox1.List(ListBox1.ListIndex, 0)
maxrow = ws.Cells(Rows.count, "A").End(xlUp).Row 'sheetの最大行取得
erow = 0
For wrow = 2 To maxrow
If ws.Cells(wrow, "A").Value = zaiko Then
erow = wrow
End If
Next
If erow = 0 Then Exit Sub
With ws.Cells(erow, "A")
.Resize(, 4).Copy
.Offset(1).Insert Shift:=xlDown
Application.CutCopyMode = False
For Each C In .Offset(1, 1).Resize(1, 3)
If Not C.HasFormula Then C.Value = ""
Next
End With
End Sub

この回答へのお礼

ありがとうございました。上手く使えそうです。

お礼日時：2022/06/14 16:18

No.2 回答者： KenKen_SP 回答日時： 2022/06/14 15:06

2行あれば動くのなら、ダミーデータでも置いておけば良いのでは？

それでとりあえず動くでしょう。

No.1 回答者： fujillin 回答日時： 2022/06/14 14:05

こんにちは

相変わらず、なさりたいことを示さない質問だし、履歴も非公開にしてるし・・

多分これ。
https://oshiete.goo.ne.jp/qa/12962263.html

もう何度も書いているので、繰り返しませんけれど。