|
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
|
|