| 
    
     |  | β様 
 ありがとうございました
 ▼β さん:
 >▼りえ さん:
 >
 >ご希望なので。
 >先にコメントしたところも含めて、コードは、すべて元のままにしてあります。
 >気になるところも多々ありますが・・・・・・
 >Sheet1 は必ず処理されるんだということですから、Sheet2 の部分だけを以下。
 >
 >  'sheet2
 >  Dim ws3 As Worksheet, ws4 As Worksheet
 >  Dim r1 As Range
 >  Dim n1 As Long
 >  Dim i1 As Long, j1 As Long, k1 As Long
 >  Dim done As Boolean     '★
 >
 >  Set ws3 = Workbooks("C.xls").Worksheets("Sheet2")
 >  Set ws4 = Workbooks("B.xls").Worksheets("Sheet2")
 >  Set r1 = ws4.Range("A:I").Find("*", , xlValues, xlPart, xlByRows, xlPrevious)
 >
 >  If Not r1 Is Nothing Then  '★
 >
 >    n1 = Int((r1.Row - 2) / 20)
 >
 >    If n1 >= 0 Then     '★
 >
 >      done = True     '★
 >
 >      Application.ScreenUpdating = False
 >      For i1 = 0 To n1
 >        If i1 > 0 Then ws3.Range("A1:J33").Copy ws3.Cells(33 * i1 + 1, 1)
 >        For j1 = 1 To 9
 >          If j1 = 1 Then k1 = j1 Else k1 = j1 + 1
 >          ws3.Cells(33 * i1 + 12, k1).Resize(20).Value = _
 >          ws4.Cells(20 * i1 + 2, j1).Resize(20).Value
 >        Next
 >      Next
 >
 >      Dim x1 As Long
 >      For x1 = 1 To Cells(Rows.Count, 10).End(xlUp).Row
 >        If Range("G" & x1).Value = "数" Then
 >          Range("J" & x1).Value = "送"
 >
 >        End If
 >      Next
 >
 >    End If   '★
 >
 >  End If     '★
 >
 >  Workbooks("C.xls").Close SaveChanges:=True
 >
 >  Workbooks("B.xls").Close SaveChanges:=False
 >
 >  Application.ScreenUpdating = True
 >
 >  If done Then
 >    MsgBox "終わりました"
 >  Else
 >    MsgBox "Sheet2に処理すべきデータはありませんでした"
 >  End If
 
 |  |