VBA AB列”3000”以上の数字の行をコピーし、その下にコピー行挿入、行の指定列に文字列を書く

楽天からダウンロードした注文情報CSV（Sheet1）を
倉庫発送依頼CSVフォーマットに合うようSheet2に書き出すVBAコードを作りました。

以下の動作をするコードをご教示いただけますでしょうか？

Sheet1 AD列（Sheet2ではAB列にあたる）の数値が3000以上の行を探しそれぞれ行コピーし
その下にコピーした行を挿入、
Sheet2　挿入した行のAB列は0にし、
Sheet2　挿入した行のY列にはomake-01
Sheet2　挿入した行Z列にはおまけ、と書くようにする。

宜しくお願いします。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝

SheetOption Explicit

Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim row As Long
Dim idx As Integer
Dim ColNames
ColNames = Array("出荷指示NO", "店舗ID", "配送方法", "配達指定日", "配達時間帯", "代引有無", "配送先名称", "配送先郵便番号", "配送先都道府県", "配送先住所", "配送先電話番号", "送り状備考", "顧客注文日", "配送料金", "代引手数料金", "消費税率（8or10)", "消費税小計（8%)", "消費税小計（10%）", "消費税額", "ポイント使用額", "クーポン金額", "請求合計金額", "購入者名称", "ギフトフラグ", "商品ID", "商品名", "出荷予定数", "商品単価", "倉庫連絡事項")

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")

'Sheet2のセルの書式および値を全てクリア
ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
ws2.Cells.NumberFormat = "@"

'ヘッダーの設定
For idx = 0 To UBound(ColNames)
ws2.Cells(2, idx + 1).Value = ColNames(idx)
Next

'データをコピー
For row = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row
'Sheet2のA列←Sheet1のA列
ws2.Cells(row, 1).Value = ws1.Cells(row, 1).Value

'Sheet2のB列←"01"
ws2.Cells(row, 2).Value = "01"

'Sheet2のC列←Sheet1のB列
ws2.Cells(row, 3).Value = ws1.Cells(row, 2).Value

'Sheet2のD列←Sheet1のC列
If ws1.Cells(row, 3).Value = "0" Then
ws2.Cells(row, 4).Value = ""
Else
ws2.Cells(row, 4).Value = ws1.Cells(row, 3).Value
End If

ws2.Cells(row, 4).Value = Format(ws1.Cells(row, 3).Value, "yyyy/mm/dd")

'Sheet2のE列←Sheet1のD列
Select Case True
Case Len(ws1.Cells(row, 4).Value) = 4
ws2.Cells(row, 5).Value = Left(ws1.Cells(row, 4).Value, 2) & ":00～" & Right(ws1.Cells(row, 4).Value, 2) & ":00"
Case ws1.Cells(row, 4).Value = "0"
ws2.Cells(row, 5).Value = ""
Case ws1.Cells(row, 4).Value = "1"
ws2.Cells(row, 5).Value = "午前中"
End Select

'Sheet2のF列←Sheet1のE列
Select Case ws1.Cells(row, 5).Value
Case "クレジットカード"
ws2.Cells(row, 6).Value = "発払い"
Case "代引き"
ws2.Cells(row, 6).Value = "代引"
Case Else
ws2.Cells(row, 6).Value = ws1.Cells(row, 5).Value
End Select

'Sheet2のG列←Sheet1のF列、G列
ws2.Cells(row, 7).Value = ws1.Cells(row, 6).Value & ws1.Cells(row, 7).Value

'Sheet2のH列←Sheet1のH列、I列
ws2.Cells(row, 8).Value = ws1.Cells(row, 8).Value & ws1.Cells(row, 9).Value

'Sheet2のI列←Sheet1のJ列
ws2.Cells(row, 9).Value = ws1.Cells(row, 10).Value

'Sheet2のJ列←Sheet1のK列、L列
ws2.Cells(row, 10).Value = ws1.Cells(row, 11).Value & ws1.Cells(row, 12).Value

'Sheet2のK列←Sheet1のM列、N列、O列
ws2.Cells(row, 11).Value = ws1.Cells(row, 13).Value & ws1.Cells(row, 14).Value & ws1.Cells(row, 15).Value

'Sheet2のL列←Sheet1のP列
ws2.Cells(row, 12).Value = ws1.Cells(row, 16).Value

'Sheet2のM列←Sheet1のQ列
ws2.Cells(row, 13).Value = ws1.Cells(row, 17).Value

ws2.Cells(row, 13).Value = Format(ws1.Cells(row, 17).Value, "yyyy/mm/dd")

'Sheet2のN列←Sheet1のR列
ws2.Cells(row, 14).Value = ws1.Cells(row, 18).Value

'Sheet2のO列←Sheet1のS列
ws2.Cells(row, 15).Value = ws1.Cells(row, 19).Value

'Sheet2のP列←"10"
ws2.Cells(row, 16).Value = "10"

'Sheet2のR列←Sheet1のT列
ws2.Cells(row, 18).Value = ws1.Cells(row, 20).Value

'Sheet2のS列←Sheet1のT列
ws2.Cells(row, 19).Value = ws1.Cells(row, 20).Value

'Sheet2のT列←Sheet1のU列
ws2.Cells(row, 20).Value = ws1.Cells(row, 21).Value

'Sheet2のU列←Sheet1のV列
ws2.Cells(row, 21).Value = ws1.Cells(row, 22).Value

'Sheet2のV列←Sheet1のW列
ws2.Cells(row, 22).Value = ws1.Cells(row, 23).Value

'Sheet2のW列←Sheet1のX列、Y列
ws2.Cells(row, 23).Value = ws1.Cells(row, 24).Value & ws1.Cells(row, 25).Value

'Sheet2のX列←Sheet1のZ列
ws2.Cells(row, 24).Value = ws1.Cells(row, 26).Value


'Sheet2のY列←Sheet1のAA列
ws2.Cells(row, 25).Value = ws1.Cells(row, 27).Value

文字数の都合上 中略

'Sheet2のAC列←Sheet1のAE列
ws2.Cells(row, 29).Value = ws1.Cells(row, 31).Value
Next

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

Set ws2 = Nothing
Set ws1 = Nothing
End Sub

質問者からの補足コメント

• この質問は特に30代・女性の方に
  リクエストされています！←これは間違いです、どなたでも回答いただけます

    補足日時：2019/12/24 15:56

• ご回答ありがとうございます。
  実行したところ、out=out+1のふたつめのoutが青くなって
  コンパイルエラー、変数が定義されていません、と出ました。
  どこを修正するとよいでしょうか？

  No.1の回答に寄せられた補足コメントです。 補足日時：2019/12/25 10:01

No.13 ベストアンサー 回答者： rukaandkaito 回答日時： 2019/12/25 16:43

No12です

中々解決していないようなので全文を掲載しておきます
--------------------------------------------------------------------------------
Sub Main()
　Dim ws1 As Worksheet
　Dim ws2 As Worksheet
　Dim row As Integer
　Dim out As Integer
　Dim idx As Integer
　Dim ColNames
　ColNames = Array("■◇■ 省略 ■◇■")
　
　Application.ScreenUpdating = False
　Application.EnableEvents = False
　Application.Calculation = xlCalculationManual
　
　Set ws1 = ThisWorkbook.Worksheets("Sheet1")
　Set ws2 = ThisWorkbook.Worksheets("Sheet2")
　
　'Sheet2のセルの書式および値を全てクリア
　ws2.Cells.ClearContents
　'セルの書式を「文字列」に設定
　ws2.Cells.NumberFormat = "@"
　
　'ヘッダーの設定
　For idx = 0 To UBound(ColNames)
　　ws2.Cells(2, idx + 1).Value = ColNames(idx)
　Next
　
　out = 3
　
　'データをコピー
　For row = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row
　　'Sheet2のA列←Sheet1のA列
　　ws2.Cells(out, 1).Value = ws1.Cells(row, 1).Value
　　
　　'■◇■ 中略 ■◇■
　　
　　'Sheet2のAC列←Sheet1のAE列
　　ws2.Cells(out, 29).Value = ws1.Cells(row, 31).Value
　　
　　'AD列3000以上
　　If ws1.Cells(row, 30).Value >= 3000 Then
　　　out = out + 1
　　　ws2.Rows(out - 1 & ":" & out - 1).AutoFill Destination:=Rows(out - 1 & ":" & out), Type:=xlFillCopy
　　　'Yにomake-01
　　　ws2.Cells(out, 23).Value = "omake-01"
　　　'Zにおまけ
　　　ws2.Cells(out, 24).Value = "おまけ"
　　　'ABに0
　　　ws2.Cells(out, 26).Value = 0
　　End If
　　
　　out = out + 1
　　
　Next
　
　Application.ScreenUpdating = True
　Application.EnableEvents = True
　Application.Calculation = xlCalculationAutomatic
　
　Set ws2 = Nothing
　Set ws1 = Nothing
　
End Sub
--------------------------------------------------------------------------------
当方ではこのコードにて正常動作を確認しました

この回答へのお礼

返信が遅くなり申し訳ありません。なぜかエラーが出るので、検証中です。VBAの本を2冊読んで勉強した後、改めてまた教えてgooに投稿しようと思います。ありがとうございました＾＾

お礼日時：2020/01/09 17:41

No.12 回答者： rukaandkaito 回答日時： 2019/12/25 16:18

No6です

恐らくですが
エラーが出ている場所は
ws2.Cells(out, 29).Value = ws1.Cells(row, 31).Value
この部分ではないでしょうか
直前にoutに対し値を設定していないためかと考えられます
該当行の前に
out=3
を挿入してみてください

この回答へのお礼

ありがとうございました＾＾

お礼日時：2020/01/09 17:40

No.11 回答者： GooUserラック 回答日時： 2019/12/25 15:30

大変申し訳ございません

「End If ' ← 追加」の位置が違っていました
------------------------------------------------------------------------------
　　　Drow = Drow + 1 ' ← 追加
　　　ws2.Cells(Drow, 25).Value = "omake-01" ' ← 追加
　　　ws2.Cells(Drow, 26).Value = "おまけ" ' ← 追加
　　　ws2.Cells(Drow, 28).Value = 0 ' ← 追加
　　End If ' ← 追加

'張付先行セット
　　Drow = Drow + 1 ' ← 追加
------------------------------------------------------------------------------
を
------------------------------------------------------------------------------
　　　Drow = Drow + 1 ' ← 追加
　　　ws2.Cells(Drow, 25).Value = "omake-01" ' ← 追加
　　　ws2.Cells(Drow, 26).Value = "おまけ" ' ← 追加
　　　ws2.Cells(Drow, 28).Value = 0 ' ← 追加

　　　Drow = Drow + 1 ' ← 追加
　　End If ' ← 追加
------------------------------------------------------------------------------
にして下さい

この回答へのお礼

ありがとうございました＾＾

お礼日時：2020/01/09 17:39

No.10 回答者： GooUserラック 回答日時： 2019/12/25 15:23

No.9 の補足　以下を付け忘れました。

'張付先行セット
Drow = 3 '← 追加

この回答へのお礼

ありがとうございました＾＾

お礼日時：2020/01/09 17:39

No.9 回答者： GooUserラック 回答日時： 2019/12/25 15:18

２回に分けても構わないので全て載せてみて下さい。

Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
' Dim row As Long ' ← 削除
Dim Srow As Long ' ← 追加
Dim Drow As Long ' ← 追加
Dim idx As Integer
Dim ColNames

　ColNames = Array("出荷指示NO", "店舗ID", "配送方法", "配達指定日", "配達時間帯", "代引有無", "配送先名称", "配送先郵便番号", "配送先都道府県", "配送先住所", "配送先電話番号", "送り状備考", "顧客注文日", "配送料金", "代引手数料金", "消費税率（8or10)", "消費税小計（8%)", "消費税小計（10%）", "消費税額", "ポイント使用額", "クーポン金額", "請求合計金額", "購入者名称", "ギフトフラグ", "商品ID", "商品名", "出荷予定数", "商品単価", "倉庫連絡事項")

　Application.ScreenUpdating = False
　Application.EnableEvents = False
　Application.Calculation = xlCalculationManual

　Set ws1 = ThisWorkbook.Worksheets("Sheet1")
　Set ws2 = ThisWorkbook.Worksheets("Sheet2")

'セルの書式および値を全てクリア
　ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
　ws2.Cells.NumberFormat = "@"

'ヘッダーの設定
　For idx = 0 To UBound(ColNames)
　　ws2.Cells(2, idx + 1).Value = ColNames(idx)
　Next

'データをコピー
'　For row = 3 To ws1.Cells(Srows.Count, 1).End(xlUp).row ' ← 削除
　For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row ' ← 追加（置換後「Srows.Count」を「Rows.Count」に変更して下さい）
　
　　If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加

'A列←A列
　　　ws2.Cells(Drow, 1).Value = ws1.Cells(Srow, 1).Value

'B列←"01"
　　　ws2.Cells(Drow, 2).Value = "01"

'C列←B列
　　　ws2.Cells(Drow, 3).Value = ws1.Cells(Srow, 2).Value

'D列←C列
　　　If ws1.Cells(Srow, 3).Value = "0" Then
　　　　ws2.Cells(Drow, 4).Value = ""
　　　Else
　　　　ws2.Cells(Drow, 4).Value = ws1.Cells(Srow, 3).Value
　　　End If
　　　ws2.Cells(Drow, 4).Value = Format(ws1.Cells(Srow, 3).Value, "yyyy/mm/dd")

'E列←D列
　　　Select Case True
　　　　Case Len(ws1.Cells(Srow, 4).Value) = 4
　　　　　ws2.Cells(Drow, 5).Value = Left(ws1.Cells(Srow, 4).Value, 2) & ":00～" & Right(ws1.Cells(Srow, 4).Value, 2) & ":00"
　　　　Case ws1.Cells(Srow, 4).Value = "0"
　　　　　ws2.Cells(Drow, 5).Value = ""
　　　　Case ws1.Cells(Srow, 4).Value = "1"
　　　　　ws2.Cells(Drow, 5).Value = "午前中"
　　　End Select

'F列←E列
　　　Select Case ws1.Cells(Srow, 5).Value
　　　　Case "クレジットカード"
　　　　　ws2.Cells(Drow, 6).Value = "発払い"
　　　　Case "代引き"
　　　　　ws2.Cells(Drow, 6).Value = "代引"
　　　　Case Else
　　　　　ws2.Cells(Drow, 6).Value = ws1.Cells(Srow, 5).Value
　　　End Select

'G列←F列、G列
　　　ws2.Cells(Drow, 7).Value = ws1.Cells(Srow, 6).Value & ws1.Cells(Srow, 7).Value

'H列←H列、I列
　　　ws2.Cells(Drow, 8).Value = ws1.Cells(Srow, 8).Value & ws1.Cells(Srow, 9).Value

'I列←J列
　　　ws2.Cells(Drow, 9).Value = ws1.Cells(Srow, 10).Value

'J列←K列、L列
　　　ws2.Cells(Drow, 10).Value = ws1.Cells(Srow, 11).Value & ws1.Cells(Srow, 12).Value

'K列←M列、N列、O列
　　　ws2.Cells(Drow, 11).Value = ws1.Cells(Srow, 13).Value & ws1.Cells(Srow, 14).Value & ws1.Cells(Srow, 15).Value

'L列←P列
　　　ws2.Cells(Drow, 12).Value = ws1.Cells(Srow, 16).Value

'M列←Q列
'　　　ws2.Cells(Drow, 13).Value = ws1.Cells(Srow, 17).Value ' ← 削除
　　　ws2.Cells(Drow, 13).Value = Format(ws1.Cells(Srow, 17).Value, "yyyy/mm/dd")

'N列←R列
　　　ws2.Cells(Drow, 14).Value = ws1.Cells(Srow, 18).Value

'O列←S列
　　　ws2.Cells(Drow, 15).Value = ws1.Cells(Srow, 19).Value

'P列←"10"
　　　ws2.Cells(Drow, 16).Value = "10"

'R列←T列
　　　ws2.Cells(Drow, 18).Value = ws1.Cells(Srow, 20).Value

'S列←T列
　　　ws2.Cells(Drow, 19).Value = ws1.Cells(Srow, 20).Value

'T列←U列
　　　ws2.Cells(Drow, 20).Value = ws1.Cells(Srow, 21).Value

'U列←V列
　　　ws2.Cells(Drow, 21).Value = ws1.Cells(Srow, 22).Value

'V列←W列
　　　ws2.Cells(Drow, 22).Value = ws1.Cells(Srow, 23).Value

'W列←X列、Y列
　　　ws2.Cells(Drow, 23).Value = ws1.Cells(Srow, 24).Value & ws1.Cells(Srow, 25).Value

'X列←Z列
　　　ws2.Cells(Drow, 24).Value = ws1.Cells(Srow, 26).Value

'Y列←AA列
　　　ws2.Cells(Drow, 25).Value = ws1.Cells(Srow, 27).Value

'中略

'AC列←AE列
　　　ws2.Cells(Drow, 29).Value = ws1.Cells(Srow, 31).Value
　　　
　　　Drow = Drow + 1 ' ← 追加
　　　ws2.Cells(Drow, 25).Value = "omake-01" ' ← 追加
　　　ws2.Cells(Drow, 26).Value = "おまけ" ' ← 追加
　　　ws2.Cells(Drow, 28).Value = 0 ' ← 追加
　　End If ' ← 追加

'張付先行セット
　　Drow = Drow + 1 ' ← 追加
　　　
　Next

　Application.ScreenUpdating = True
　Application.EnableEvents = True
　Application.Calculation = xlCalculationAutomatic

　Set ws2 = Nothing
　Set ws1 = Nothing

End Sub

この回答へのお礼

ありがとうございました＾＾

お礼日時：2020/01/09 17:39

No.8 回答者： GooUserラック 回答日時： 2019/12/25 14:47

移動するのは「If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加」だけです。

他はそのままにしてみて下さい。

この回答へのお礼

Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Srow As Long ' SourceRow ← 追加
Dim Drow As Long ' DestinationRow ← 追加
Dim idx As Integer
Dim ColNames
ColNames = Array("出荷指示NO", 　略　"倉庫連絡事項")

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")

'Sheet2のセルの書式および値を全てクリア
ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
ws2.Cells.NumberFormat = "@"

'ヘッダーの設定
For idx = 0 To UBound(ColNames)
ws2.Cells(2, idx + 1).Value = ColNames(idx)
Next

'張付先行セット
Drow = 3 '← 追加

'データをコピー
For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row
If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加

Drowから下は下の方、
'張付先行セット
Drow = Drow + 1 ' ← 追加
Next
の上にあります。

No5と同じ状態になりました(T_T)
（AD列2425や2722でも下に行挿入されます。
またY列、Z列、AB列以外は空白になっています。）

お礼日時：2019/12/25 15:08

No.7 回答者： GooUserラック 回答日時： 2019/12/25 14:19

大変申し訳ございません。

チャント本文を見てませんでした。
「If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加」の位置を「For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row」のすぐ後に入れ変えて下さい。
多分これで良いと思いますが何かあったら言ってください。

この回答へのお礼

実行したところY、Z、AB列の文字消え空白行追加に(T_T)エクセルはオフィス365です
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Srow As Long ' SourceRow ← 追加
Dim Drow As Long ' DestinationRow ← 追加
Dim idx As Integer
Dim ColNames
ColNames = Array("出荷指示NO", 　中略　"倉庫連絡事項")

中略

'Sheet2のセルの書式および値を全てクリア
ws2.Cells.ClearContents
'セルの書式を「文字列」に設定
ws2.Cells.NumberFormat = "@"

'ヘッダーの設定
For idx = 0 To UBound(ColNames)
ws2.Cells(2, idx + 1).Value = ColNames(idx)
Next

'張付先行セット
Drow = 3 '← 追加

'データをコピー
For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).Row

'AD列の数値が3000以上の処理
If ws1.Cells(Srow, 31).Value >= 3000 Then ' ← 追加
Drow = Drow + 1 ' ← 追加
ws2.Cells(Drow, 25).Value = "omake-01" ' ← 追加
ws2.Cells(Drow, 26).Value = "おまけ" ' ← 追加
ws2.Cells(Drow, 28).Value = 0 ' ← 追加
End If ' ← 追加

中略

'張付先行セット
Drow = Drow + 1 ' ← 追加

Next

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

Set ws2 = Nothing
Set ws1 = Nothing
End Sub

お礼日時：2019/12/25 14:36

No.6 回答者： rukaandkaito 回答日時： 2019/12/25 13:55

No1です

Sum Mainの下のDim定義がある所に
Dim out As Integer
でいけます
ただし、ws2側のRowは全てoutに置き換えないといけませんよ！
今のままだとws1と同じrowに書き込むようになっていますから

この回答へのお礼

No1とNo6をもとに
s2.Cells(Rowをws2.Cells(outにすべて置換し、
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim row As Long
Dim idx As Integer
Dim out As Integer
Dim ColNames
ColNames = Array("略　のようにDim out As Integerを追加し、

'Sheet2のAC列←Sheet1のAE列
ws2.Cells(out, 29).Value = ws1.Cells(row, 31).Value
Nextの下に
'AD列３０００以上
IF ws1.Cells(row, 30).Value>=3000 Then
　out=out+1
　ws2.Rows(out-1 & ":" & out-1).AutoFill Destination:=Rows(out-1 & ":" & out), Type:=xlFillCopy
　'Yにomake-01
　ws2.Cells(out, 23).Value="omake-01"
　'Zにおまけ
　ws2.Cells(out, 24).Value="おまけ"
　'ABに0
　ws2.Cells(out, 26).Value=0
End If
を入れました。
実行時エラー１００４、アプリケーションまたはオブジェクト定義のエラーです。と出ます。
何が原因でしょう(T_T)

お礼日時：2019/12/25 14:53

No.5 回答者： GooUserラック 回答日時： 2019/12/25 12:12

大変申し訳ございません。

間違えが有りました。

「Drow = 3 ← 追加」は「Drow = 3 ' ← 追加」にしてください。

「 ws2.Cells(Drow, 25).Value = "おまけ" ' ← 追加」は「ws2.Cells(Drow, 26).Value = "おまけ" ' ← 追加」にしてください。

修正自体が間違っていました。
「For row = 3 To ws1.Cells(rows.Count, 1).End(xlUp).row」は「For Srow = 3 To ws1.Cells(Rows.Count, 1).End(xlUp).row」にしてください。

この回答へのお礼

度々回答ありがとうございます。
実行したところエラーは無いのですが、
AD列2425や2722でも下に行挿入されているので3000以上の場合のみ行挿入したいです。
またY列、Z列、AB列以外は空白になっているので空白にならないようにしたいです。

わかりにくい内容ですみません。。何卒宜しくお願いします。

＞Sheet1 AD列（Sheet2ではAB列にあたる）の数値が
＞3000以上の行を探しそれぞれ行コピーし
＞その下にコピーした行を挿入、
＞Sheet2　挿入した行のAB列は0にし、
＞Sheet2　挿入した行のY列にはomake-01
＞Sheet2　挿入した行Z列にはおまけ、と書くようにする。

お礼日時：2019/12/25 14:01

No.4 回答者： GooUserラック 回答日時： 2019/12/25 11:15

「For row = 3 To ws1.Cells(Srows.Count, 1).End(xlUp).row」はコードで示しましたが「For Srow = 3 To ws1.Cells(Srows.Count, 1).End(xlUp).row」です。

申し訳ございません「← 削除」「← 追加」をつけ忘れていました。

この回答へのお礼

ありがとうございます！修正しました！

お礼日時：2019/12/25 14:02