エクセルVBAについて

tatsumaru77様
以前投稿した内容で転記の追加をしたいのですが、内容は添付画像のようにA列に〇がある場合にW列の品名を別ファイルのC列に追加、AS列の個数をD列に追加です。
追加していく条件は変更はありません。
現在使用しているコードも記載しておきます。
申し訳ありませんが、よろしくお願いいたします。

Private Sub case8()

Dim fpath As String
Dim wb As Workbook
Dim ws1 As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet
Dim maxrow1 As Long
Dim row1 As Long
Dim row2 As Long
Set ws1 = ActiveSheet
fpath = "N:\01生産管理課\01 個人ファイル\5000田中\図番転記.xlsm"
Set wb2 = Nothing
For Each wb In Workbooks
If wb.Name = "図番転記.xlsm" Then
Set wb2 = wb
Exit For
End If
Next
If wb2 Is Nothing Then
Set wb2 = Workbooks.Open(fpath)
End If
Set ws2 = wb2.Worksheets(1)
row2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
If ws2.Cells(row2, "A").Value <> "" Then
row2 = row2 + 1
End If
maxrow1 = 500
For row1 = 10 To maxrow1
If ws1.Cells(row1, "A").Value = "○" Then
ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
ws1.Cells(row1, "O").Value & ws1.Cells(row1, "S").Value & ws1.Cells(row1, "U").Value
ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
ws1.Cells(row1, "O").Value & "10_00*"
row2 = row2 + 1
End If
Next
End Sub

No.1 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/05/06 13:53

以下のように,

For row1 = 10 To maxrow1
のループの中に、'追加と記述されている２行を追加してください。
（動作確認はしていません）


For row1 = 10 To maxrow1
If ws1.Cells(row1, "A").Value = "○" Then
ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
ws1.Cells(row1, "O").Value & ws1.Cells(row1, "S").Value & ws1.Cells(row1, "U").Value
ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
ws1.Cells(row1, "O").Value & "10_00*"
ws2.Cells(row2, "C").Value = ws1.Cells(row1, "W").Value '追加
ws2.Cells(row2, "D").Value = ws1.Cells(row1, "AS").Value '追加
row2 = row2 + 1
End If
Next

この回答へのお礼

ありがとうございます。
感謝いたします。

お礼日時：2024/05/06 18:29