| 
    
     |  | YN63さん、こんにちは 
 まだ出先なのですが、Netに繋ぐ時間ができましたので
 とりあえず、コードをUP致します。
 ただし、検証できる環境がございませんので、未検証の
 コードとなります。
 なので、一応コメントを付けますね。
 ご確認ください。
 
 Sub 累計転記()
 '集計するシート名
 Const strUSH As String = "月次/年年度集計"
 Dim SH As Worksheet
 Dim lngRow As Long
 
 For Each SH In Worksheets
 If SH.Name <> strUSH _
 And SH.Name <> "集計表" Then
 With Sheets(strUSH)
 '集計表の最終行を取得
 lngRow = .Range("A65536").End(xlUp).Row + 1
 'コードNoを転記
 .Range("A" & lngRow).Value = SH.Range("A2").Value
 '営業所名を転記
 .Range("B" & lngRow).Value = SH.Range("B2").Value
 '累計を転記
 .Range("D" & lngRow).Value = SH.Range("A65536").End(xlUp).Offset(, 3).Value
 End With
 End If
 Next
 '転記したデータをソートする
 Sheets(strUSH).Range("A4:D" & lngRow).Sort _
 Key1:=Range("A4"), _
 Order1:=xlAscending, _
 Header:=xlGuess
 End Sub
 
 |  |