| 
    
     |  | シリアル番号の桁数が揃っていない(7桁,8桁)ことに気づくのに時間がかかりました。 
 二つ載せます。
 test1はごく基本的なもの。行数によっては時間がかかるかもしれません。
 test2はオートフィルタを使ったもの。
 
 いずれもテストをしてから使って下さい。
 (こちらの環境ではOKでしたが、そちらの環境では不明です。色々ありますから。
 A列に今回以外の何か値が残っていると、それも対象になるので注意)
 
 Sub test1()
 Dim rng As Range
 Dim k As Long
 With Worksheets("sheet2")
 For k = 2 To .Cells(.Rows.count, "A").End(xlUp).Row
 If .Cells(k, "A").Value <> "" Then
 .Cells(k, "A").ClearContents
 .Cells(k, "C").Value = "田中"
 End If
 Next
 End With
 End Sub
 
 Sub test2()
 Dim rng As Range, body As Range
 
 Set rng = Worksheets("Sheet2").Range("A1").CurrentRegion
 Set body = Intersect(rng, rng.Offset(1))
 
 rng.AutoFilter Field:=1, Criteria1:="<>", Operator:=xlAnd
 body.Columns(3).Value = "田中"
 body.Columns(1).ClearContents
 rng.AutoFilter
 End Sub
 
 |  |