| 
    
     |  | おはようございます。 
 >  Do While sh2.Cells(cnt1, 2).Value <> ""
 >  cnt = cnt1 + 1
 >  Loop
 では、cnt1だけが、回ってしまいます。
 それと、cnt 「1」が抜けています。
 
 Private Sub CommandButton1_Click()
 Dim bk As Workbook
 Dim sh1 As Worksheet
 Dim sh2 As Worksheet
 Dim cnt1 As Long
 
 Set bk = ThisWorkbook
 
 Set sh1 = bk.Worksheets("現場登録検索")
 Set sh2 = bk.Worksheets("一覧")
 cnt1 = 6
 With sh2
 Do While .Cells(cnt1, 2).Value <> ""
 
 '得意先CD
 .Cells(cnt1, 2).Value = sh1.Cells(2, 3).Value
 
 '現場CD
 .Cells(cnt1, 3).Value = sh1.Cells(3, 3).Value
 
 '送り方
 .Cells(cnt1, 22).Value = sh1.Cells(4, 3).Value
 
 '封筒
 .Cells(cnt1, 23).Value = sh1.Cells(5, 3).Value
 
 cnt1 = cnt1 + 1
 
 Loop
 End With
 
 MsgBox "登録できました。"
 
 End Sub
 
 で意図したように動くと思います。
 
 
 |  |