Sub 连续打印()
Dim i
i = 16
For i = 16 To 30
    If Cells(i, 2) = "" Then
           MsgBox "================亲，批量打印完成！=================="
           Exit Sub
    End If
  Cells(2, 5) = Cells(i, 2)
  Call 查找内容省窗
  
  ThisWorkbook.PrintPreview
   
Next
End Sub
Sub 查找内容省窗()
With Sheets("记录汇总")
lastrow = .Cells(10000, 1).End(xlUp).Row
Rng = .Range("a2:b" & lastrow)


For i = 1 To UBound(Rng)
    If Rng(i, 1) = Cells(2, 5) Then
            rng1 = .Range(.Cells(i + 1, 2), .Cells(i + 1, 62))
            Range("e3").Resize(61, 1) = Application.Transpose(rng1)
           ' MsgBox "查询成功！"
    Range("E53").Select
    Selection.Copy
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E54").Select
    Selection.Copy
    Range("F20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
   
    'MsgBox "===============查询成功！================"
            Exit Sub
    End If
   
Next
   
End With
MsgBox ("=========不好意思，没有查到此ID的相关记录===========!")
 
End Sub

这里的版主风吹过b或许能帮到你。吹水佬版主也行，只不过他来本版块较少，在vfp版块活动较多。

我自己现在搞成这样了，后面请大神看看怎么显示查不到的单号！
Sub 连续打印()
Dim b, x
x = 16
b = 15
Do While b <= 30
   b = b + 1
    If Cells(b, 2) = "" Then
        
        
        If b - x > 0 Then
             MsgBox "有" & b - x & "个单号不正确，没有打印"
             Exit Sub
        End If
   
   
           MsgBox "=====亲，批量打印完成！共批量打印" & b - 16 & "张生产单====="
           Exit Sub
    End If
  Cells(2, 5) = Cells(b, 2)
With Sheets("记录汇总")
lastrow = .Cells(10000, 1).End(xlUp).Row
Rng = .Range("a2:b" & lastrow)


  For i = 1 To UBound(Rng)
      If Rng(i, 1) = Cells(2, 5) Then
            rng1 = .Range(.Cells(i + 1, 2), .Cells(i + 1, 62))
            Range("e3").Resize(61, 1) = Application.Transpose(rng1)
           ' MsgBox "查询成功！"
      Range("E53").Select
      Selection.Copy
      Range("F7").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Range("E54").Select
      Selection.Copy
      Range("F20").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
      Range("A1").Select
    x = x + 1
       'MsgBox "===============查询成功！================"
       ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False '快速打印
  
       'ThisWorkbook.PrintPreview '预览打印，选择打印机。
      Exit For

End If
Next  
End With

Loop

End Sub

我自己搞成上面那样，你帮我看看要怎么完善？