Ｉ列でＨＩＴさせたデータのみ、別のシートにコピーしたい。（マクロ）

質問

エクセルでのご教授をお願いします。

シート名「データ」のＡ３からＭ１５９までに、データが入力済みです。
ただし、今後、列方向・行方向ともにデータが増える可能性があります。

Ｉ列の入力値は、現在、「１・２・３・４」のどれかです。
今後、「５・６」と増えてゆく可能性もありますが、とりあえずそれは後ほど考えます。

やりたいことですが、
Ｉ列のデータが「１」だけのものをまず抽出し、
抽出されたデータの、Ａ列・Ｂ列・Ｃ列・Ｈ列・Ｊ列・Ｋ列・Ｌ列のみを、シート名「１」の３行目以降にコピーしたいのです。

同じくＩ列のデータが「２」だけのものを抽出し、
抽出されたデータの、Ａ列・Ｂ列・Ｃ列・Ｈ列・Ｊ列・Ｋ列・Ｌ列のみを、シート名「２」の３行目以降にコピーしたいのです。

これをＩ列に入力されるデータそれぞれに（現在は４まで）をマクロで作成したいのです。

そして、私ではどうしても解決できなかったことなのですが、
例えば「１」シートの最終データの次の行に、集計欄として、データが何件あるかを数えたいのです。
その場合、Ｉ列のデータがそれぞれのデータごとに何件あるかが分からないために、どの行に集計欄を作成しておけば良いのか、どうやって判断させたら良いのでしょうか。

申し上げていることを理解していただけておりますでしょうか。
もし意味不明な箇所がございましたら、補足で尋ねていただけると助かります。

よろしくお願いいたします。

回答No.9

taisuke555 · ベストアンサー

すいません。
それに対応して、配列を初期化したのに・・・

For i = 1 To S_No
S_Line(i) = Start_Line
s_kei(i) = 0
s_true(i) = 0
s_false(0) = 0　　→　　s_false(i) = 0
Next i

に変更してください。
申し訳ありません。これで表示されると思います。

お礼

何度もご回答をいただき、本当にありがとうございました。
おかげ様で、完成間近です。
２０ポイントしか差し上げられないのが、とても残念です。
また、このカテゴリにて新しい質問を出す予定があるので、お力添えいただけるようでしたら、お願いします（笑）。

※皆様へ
たいへん素晴らしい技術を提供していただきましたたおかげで、表も完成間近です。
本当にありがとうございました。
ポイント発行は、taisuke555様に20ポイント、nishi6様に10ポイントとさせていただきます。
また機会がございましたら、よろしくお願いいたします。

回答No.8

taisuke555

補足のVBAです。
一応（１）～（４）を網羅したつもりですが、あわてて作ったので
もし、エラーが出たり、おかしな所は再度補足してください。
（できれば、どのようなデータがあるときなど詳細を頂ければありがたいです）

Sub Data_Chk()
Start_Line = 3 '各シートのコピー開始行
'シートNoチェック
S_No = 0 '最大のシート番号
For Each ws In Worksheets
If (IsNumeric(ws.Name)) Then 'シート名が数字
If (S_No < Val(ws.Name)) Then 'S_Noがシート名より小さければ
S_No = Val(ws.Name) 'S_Noにシート名を代入
End If
'ws.Cells.ClearContents '各シートのデータをクリア
ws.Range(ws.Cells(3, 1), ws.Cells(Rows.Count, Columns.Count)).Clear'各シートのA3～罫線を含めクリア
End If
Next ws
ReDim S_Line(S_No) '各シートの最終行
ReDim s_kei(S_No) '各シートのD列合計
ReDim s_true(S_No) '各シートの可合計
ReDim s_false(S_No) '各シートの否合計
'各シートの表示開始行を設定、各配列の初期化
For i = 1 To S_No
S_Line(i) = Start_Line
s_kei(i) = 0
s_true(i) = 0
s_false(0) = 0
Next i

'データチェック
With Worksheets("データ")
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row 'シート名［データ］の３行目から入力の終りの行まで
If (IsNumeric(.Cells(i, 9))) Then 'I列が数値ならば
w_no = .Cells(i, 9) 'I列(９列目）の値を代入
If (w_no > 0 And w_no <= S_No) Then
Worksheets(CStr(w_no)).Cells(S_Line(w_no), 1) = .Cells(i, 1) 'A列→A列
Worksheets(CStr(w_no)).Cells(S_Line(w_no), 2) = .Cells(i, 2) 'B列→B列
Worksheets(CStr(w_no)).Cells(S_Line(w_no), 3) = .Cells(i, 3) 'C列→C列
Worksheets(CStr(w_no)).Cells(S_Line(w_no), 4) = .Cells(i, 8) 'H列→D列
Worksheets(CStr(w_no)).Cells(S_Line(w_no), 5) = .Cells(i, 10) 'J列→E列
Worksheets(CStr(w_no)).Cells(S_Line(w_no), 6) = .Cells(i, 11) 'K列→F列
Worksheets(CStr(w_no)).Cells(S_Line(w_no), 7) = .Cells(i, 12) 'L列→G列
s_kei(w_no) = s_kei(w_no) + Worksheets(CStr(w_no)).Cells(S_Line(w_no), 4) 'シート［データ］のD列合計
's_kei(w_no) = s_kei(w_no) + .Cells(i, 4) '各シートのD列合計

If (Worksheets(CStr(w_no)).Cells(S_Line(w_no), 7) = "可") Then '各シートのG列チェック
'If (.Cells(i, 7) = "可") Then 'シート［データ］のG列チェック
s_true(w_no) = s_true(w_no) + 1
ElseIf (Worksheets(CStr(w_no)).Cells(S_Line(w_no), 7) = "否") Then '各シートのG列チェック
'elseIf (.Cells(i, 7) = "否") Then 'シート［データ］のG列チェック
s_false(w_no) = s_false(w_no) + 1
End If

S_Line(w_no) = S_Line(w_no) + 1 '表示列を１加算
End If
End If
Next i
End With
'各シートに件数を表示(B列,D列,E列)
For i = 1 To S_No
With Worksheets(CStr(i))
.Cells(S_Line(i), 2) = "計　" & Format(S_Line(i) - Start_Line, "#,##0") & "団体"
.Cells(S_Line(i), 4) = Format(s_kei(i), "#,##0")
.Cells(S_Line(i), 5) = "（公 表 可：" & Format(s_true(i), "#,##0") & "団体 否：" & Format(s_false(i), "#,##0") & "団体）"
'罫線
With .Range("A3:G" & CStr(S_Line(i)))
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End With
Next i
End Sub

（４）については、「データ」シートのD列、G列なのか
　　　各シートのD列（「データ」シートのH列）、G列（「データ」シートのL列）なのか
　　　わからなかったので両方のせてあります。
　　　（一応、現在は、各シートのD列、G列を採用しています）
　　　違う場合は、コメントの行を入れ替えてください（分からなければ補足してください）

詳細のチェック（例えば、D列に数字が入っていなかったり、文字が入っていたり）
はしておりません（時間がなかったので）
何か気づいた点は補足していただければ、修正します。
間違った解釈をしていたら申し訳ありません。

お礼

ありがとうございました。
おかげ様で、仕事が数倍早くこなせております。
ご解釈も、まさに私が欲していた作業で、大変嬉しかったです。

１点だけ、教えていただきたいのですが、
集計行にて「公表可○団体　公表否○団体」の表示について、
公表否が０件のＨＩＴですと、０と表示されずにただの「団体」となってしまうのですが、
これについては解決のしようがございませんでしょうか。

ここまで作っていただいて、本当に心苦しいのですが、
私自身がこのような作業を行う技術がないもので、
この場をお借りして、再度、ご返答をいただければ、と思っております。

お時間のございますときに、ご教授いただければ幸いです。

回答No.7

nishi6

＞（２）シート「１」や「２」のデータの周りに?、格子罫線を引きたいです。
＞（３）・・・１行目，２行目の文字列が消えてしまいます。→残せますか？

両方、対応してみました。
罫線を操作するとどうしてもコードが長くなってしまいます。

Sub Furiwake()
　　Dim rw() As Long '行
　　Const wsMax = 4 '今のところ、シートは『4』まで
　　Const copyCol = "ABCHJKL" 'コピーする列

　　ReDim rw(wsMax)
　　Dim rg As Range 'セル
　　Dim ws 'シート番号
　　Dim c As Integer 'カウンタ

　　For c = 1 To 4 'Sheet[1]～Sheet[4]をクリア
　　　　With Worksheets(CStr(c)).Range("A3:G1000") 'テキトーだが1000行目までを消す
　　　　　　.ClearContents
　　　　　　'既に引いてある罫線を消す
　　　　　　.Borders(xlEdgeLeft).LineStyle = xlNone
　　　　　　.Borders(xlEdgeTop).LineStyle = xlNone
　　　　　　.Borders(xlEdgeBottom).LineStyle = xlNone
　　　　　　.Borders(xlEdgeRight).LineStyle = xlNone
　　　　　　.Borders(xlInsideVertical).LineStyle = xlNone
　　　　　　.Borders(xlInsideHorizontal).LineStyle = xlNone
　　　　End With
　　Next
　　'データを各シートに振り分ける
　　With Worksheets("データ")
　　　　rw(0) = 3: ws = .Cells(rw(0), 9).Text
　　　　While ws <> ""
　　　　　　rw(ws) = Application.Max(rw(ws) + 1, 3)
　　　　　　For c = 1 To Len(copyCol) '指定した列をコピーする
　　　　　　　　Worksheets(ws).Cells(rw(ws), c) = .Range(Mid(copyCol, c, 1) & rw(0))
　　　　　　Next

　　　　　　rw(0) = rw(0) + 1: ws = .Cells(rw(0), 9).Text
　　　　Wend
　　End With

　　Dim TBL As Range
　　Application.ScreenUpdating = False
　　For c = 1 To 4 '合計を書く(場所の指定がないので、A列の最後に書く)
　　　　If rw(c) > 2 Then 'データがあれば
　　　　　　Worksheets(CStr(c)).Cells(rw(c) + 1, 1) = rw(c) - 2

　　　　　　Worksheets(CStr(c)).Activate
　　　　　　Set TBL = Worksheets(CStr(c)).Range("A3").CurrentRegion
　　　　　　'合計箇所に罫線を引かない場合は、TBL.Rows.Count - 3 とします。
　　　　　　TBL.Offset(2, 0).Resize(TBL.Rows.Count - 2, TBL.Columns.Count).Select
　　　　　　'罫線を書く
　　　　　　Call Keisen(xlContinuous, xlEdgeLeft)
　　　　　　Call Keisen(xlContinuous, xlEdgeTop)
　　　　　　Call Keisen(xlContinuous, xlEdgeBottom)
　　　　　　Call Keisen(xlContinuous, xlEdgeRight)
　　　　　　Call Keisen(xlContinuous, xlInsideVertical)
　　　　　　Call Keisen(xlContinuous, xlInsideHorizontal)
　　　　End If
　　Next
　　Worksheets("データ").Select
　　Application.ScreenUpdating = True
End Sub

Sub Keisen(myStyle As Long, myBorder As Long)
　　With Selection.Borders(myBorder)
　　　　.LineStyle = myStyle
　　　　.Weight = xlThin
　　End With
End Sub

お礼

見易さで言うと、NO.1ですね（ニコニコ）。
ただただスゴイなーと思ってしまいます。
職員も「すっごーい。きれーい。」と感激しておりました。
今後ともよろしくお願いいたします。
このたびは、本当にありがとうございました。

回答No.6

imogasi

＃２のものです。言い後れましたが、回答の中に「並べ替え」（ソート）をいれていましたが、ソートせずとも、振り分けだけならば、また振り分け後の各シート上の順番に拘らなければ、必要ありませんので、付け加えさせていただきます。

お礼

わざわざありがとうございました。
職員に伝えておきます。

回答No.5

taisuke555

＃３で回答したものです。

For Each ws In Worksheets
If (IsNumeric(ws.Name)) Then 'シート名が数字
If (S_No < Val(ws.Name)) Then 'S_Noがシート名より小さければ
S_No = Val(ws.Name) 'S_Noにシート名を代入
ws.Cells.ClearContents '各シートのデータをクリア
End If
End If
Next ws
の部分がちょっと違っているので、

For Each ws In Worksheets
If (IsNumeric(ws.Name)) Then 'シート名が数字
If (S_No < Val(ws.Name)) Then 'S_Noがシート名より小さければ
S_No = Val(ws.Name) 'S_Noにシート名を代入
End If
ws.Cells.ClearContents '各シートのデータをクリア
End If
Next ws
に変更してください。

それと＃４さんの
　　　　　　For c = 1 To Len(copyCol) '指定した列をコピーする
　　　　　　　　Worksheets(ws).Cells(rw(ws), c) = .Range(Mid(copyCol, c, 1) & rw(0))
　　　　　　Next
この部分は、私のように１つづつ書くよりすっきりしますね！
参考にさせて頂きます。

回答No.4

nishi6

シート名「１」について、この『1』は半角としてコードを書いています。

シート『データ』のI列を読み、その値で、該当シートに書き込んでいるだけです。
書き込むときに各配列に何行目に書くか記憶しています。
最後にシート毎に書き込んだデータ件数(この場合は行数-2)を最終行の次に書き込んでいます。
どこに書き込むか指定がないのでA列に書いてみました。
また、シート『データ』のＡ列・Ｂ列・Ｃ列・Ｈ列・Ｊ列・Ｋ列・Ｌ列は各シートの
Ａ列・Ｂ列・Ｃ列・Ｄ列・Ｅ列・Ｆ列・Ｇ列に書き込んでいます。ご参考に。

標準モジュールに貼り付け(Excel2000です)
↓
Sub Furiwake()
　　Dim rw() As Long '行
　　Const wsMax = 4 '今のところ、シートは『4』まで
　　Const copyCol = "ABCHJKL" 'コピーする列

　　ReDim rw(wsMax)
　　Dim rg As Range 'セル
　　Dim ws 'シート番号
　　Dim c As Integer 'カウンタ

　　For c = 1 To 4 'Sheet[1]～Sheet[4]をクリア
　　　　Worksheets(CStr(c)).Cells.ClearContents
　　Next
　　'データを各シートに振り分ける
　　With Worksheets("データ")
　　　　rw(0) = 3: ws = .Cells(rw(0), 9).Text
　　　　While ws <> ""
　　　　　　rw(ws) = Application.Max(rw(ws) + 1, 3)
　　　　　　For c = 1 To Len(copyCol) '指定した列をコピーする
　　　　　　　　Worksheets(ws).Cells(rw(ws), c) = .Range(Mid(copyCol, c, 1) & rw(0))
　　　　　　Next

　　　　　　rw(0) = rw(0) + 1: ws = .Cells(rw(0), 9).Text
　　　　Wend
　　End With

　　For c = 1 To 4 '合計を書く(場所の指定がないので、A列の最後に書く)
　　　　Worksheets(CStr(c)).Cells(rw(c) + 1, 1) = rw(c) - 2
　　Next
End Sub

お礼

試してみました。

下記の方へのお礼欄をコピーしてきて申し訳ないのですが、
私が今一番困っているのは、下記２点です。

（２）シート「１」や「２」のデータの周りに?、格子罫線を引きたいです。
　　　「データ」シートのＡ３からＭ１５９は、既に「格子罫線」で囲ってあります。
　　　シート「１」や「２」に格子罫線を先に引いておくと（多めに）、
　　　ＨＩＴデータ件数によって、行の削除を行わなければなりません。
　　　（私の説明でご理解いただけるか心配）

（３）シート「１」や「２」の１行目と２行目に、すでに表のタイトルが入力済みです。
　　　ご教授いただいたマクロを使用すると、１行目，２行目の文字列が消えてしまいます。→残せますか？

と言うわけで、もし、またお力添えいただけるようでしたら、お願いいたします。
また、とても見やすく、助かりました。
ありがとうございました。

回答No.3

taisuke555

もう、VBAで回答されている方もいらっしゃいますが・・・
一応、私も作ってみました。

１．シートが増えても使えるようにしてあります。
　　（シート名は半角数字で1,2,4のように途中が抜けていない事が条件です）
２．A,B,C列は各シートのA,B,C列にコピーするのだと思いますが、
　　H,J,K,L列はコピー先の列が書いてなかったので、D,E,F,G列にコピーしています。
３．データ件数の表示場所も書いてなかったので、最終行のG列に表示しています。
　　計算方法は、「合計件数を表示する行－コピーを開始した行」で行っています。
４．＃２さんと同じく自動実行はしませんので、ツール→マクロ→マクロ　または　　コマンドボタンや、ショートカットで実行してください。

Sub Data_Chk()
Start_Line = 3 '各シートのコピー開始行
'シートNoチェック
S_No = 0 '最大のシート番号
For Each ws In Worksheets
If (IsNumeric(ws.Name)) Then 'シート名が数字
If (S_No < Val(ws.Name)) Then 'S_Noがシート名より小さければ
S_No = Val(ws.Name) 'S_Noにシート名を代入
ws.Cells.ClearContents '各シートのデータをクリア
End If
End If
Next ws

ReDim S_Line(S_No) '各シートの最終行
'各シートの表示開始行を設定
For i = 1 To S_No
S_Line(i) = Start_Line
Next i

'データチェック
With Worksheets("データ")
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row 'シート名［データ］の３行目から入力の終りの行まで
If (IsNumeric(.Cells(i, 9))) Then 'I列が数値ならば
W_No = .Cells(i, 9) 'I列(９列目）の値を代入
If (W_No > 0 And W_No <= S_No) Then
Worksheets(CStr(W_No)).Cells(S_Line(W_No), 1) = .Cells(i, 1) 'A列→A列
Worksheets(CStr(W_No)).Cells(S_Line(W_No), 2) = .Cells(i, 2) 'B列→B列
Worksheets(CStr(W_No)).Cells(S_Line(W_No), 3) = .Cells(i, 3) 'C列→C列
Worksheets(CStr(W_No)).Cells(S_Line(W_No), 4) = .Cells(i, 8) 'H列→D列
Worksheets(CStr(W_No)).Cells(S_Line(W_No), 5) = .Cells(i, 10) 'J列→E列
Worksheets(CStr(W_No)).Cells(S_Line(W_No), 6) = .Cells(i, 11) 'K列→F列
Worksheets(CStr(W_No)).Cells(S_Line(W_No), 7) = .Cells(i, 12) 'L列→G列
S_Line(W_No) = S_Line(W_No) + 1 '表示列を１加算
End If
End If
Next i
End With
'各シートに件数を表示
For i = 1 To S_No
Worksheets(CStr(i)).Cells(S_Line(i), 7) = CStr(S_Line(i) - Start_Line) & "件"
Next i
End Sub

以上、おかしい所やわからない所があれば、補足してください。

お礼

＞以上、おかしい所やわからない所があれば、補足してください。
お優しい方ですね。
早速、ご好意に甘えて・・・m(__)m

（１）集計欄ですが、Ｂ列に作りたかったです。
　　　Ｉ列でＨＩＴした件数の次の行（集計行）のＢ列に作りたかったです。（exＨＩＴ件数が１０件→Ｂ１２）
　　　表示を　　計　（件数）団体　　とすることは可能ですか？

（２）シート「１」や「２」のデータの周りに?、格子罫線を引きたいです。
　　　「データ」シートのＡ３からＭ１５９は、既に「格子罫線」で囲ってあります。
　　　シート「１」や「２」に格子罫線を先に引いておくと（多めに）、
　　　ＨＩＴデータ件数によって、行の削除を行わなければなりません。
　　　（私の説明でご理解いただけるか心配）

（３）シート「１」や「２」の１行目と２行目に、すでに表のタイトルが入力済みです。
　　　ご教授いただいたマクロを使用すると、１行目，２行目の文字列が消えてしまいます。→残せますか？

（４）こんなことができたら、なお最高です。
　　１）シート「１・２・３・４」のＤ列，集計行のセルに、Ｄ列（数値）の合計を表示。

　　２）シート「１・２・３・４」のＥ列，集計行のセルに、Ｇ列（可and否）の各シートそれぞれの合計を表示。
　　　　※Ｇ列は「可・否」どちらかしか入りません。
　　　　【（公 表 可：４８団体 否：1団体）】のように表示できたら文句なし。

説明不足など、とても心配です。
明日、明後日（13日，14日）は、仕事で遅くなります。
補足要求などで、尋ねておいていただければ、と思います。
よろしくお願いいたします。

回答No.2

imogasi

VBAでやって見ました。デフォルメしているので、下記でやって納得して、本番用に修正してください。
（１）元データをSheet1へコピーして、バッチ的に処理することを考えている。
（２）ソートキーはC列でやっているが、問題ではI列です。テストデータ作成に力を抜いたためです。お許しを。
テストデータは
a列　b列　　　c列　　　d列
(3)a 1 1 1
(4)d 1 2 4
(5)f 2 2 2
(6)g 2 2 1
(7)h 1 3 3
(8)f 1 4 1
コードは標準モジュールに
Sub test01()
Dim s1, s2, s3, s4, s5 As Worksheet
Set s1 = Worksheets("sheet1")
Set s2 = Worksheets("sheet2")
Set s3 = Worksheets("sheet3")
Set s4 = Worksheets("sheet4")
Set s5 = Worksheets("sheet5")
i2 = 3: i3 = 3: i4 = 3: i5 = 3
d = s1.Range("a3").CurrentRegion.Rows.Count
MsgBox d
s1.Activate
s1.Range("a3:m" & (d + 2)).Select
Selection.Sort Key1:=Range("c1"), _ Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1,MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
'-------
For i = 3 To d + 2
code = s1.Cells(i, 3)
Select Case code
Case 1
s2.Cells(i2, 1) = s1.Cells(i, 1)
s2.Cells(i2, 2) = s1.Cells(i, 2)
s2.Cells(i2, 3) = s1.Cells(i, 3)
i2 = i2 + 1
Case 2
s3.Cells(i3, 1) = s1.Cells(i, 1)
s3.Cells(i3, 2) = s1.Cells(i, 2)
s3.Cells(i3, 3) = s1.Cells(i, 3)
i3 = i3 + 1
Case 3
s4.Cells(i4, 1) = s1.Cells(i, 1)
s4.Cells(i4, 2) = s1.Cells(i, 2)
s4.Cells(i4, 3) = s1.Cells(i, 3)
i4 = i4 + 1
Case 4
s5.Cells(i5, 1) = s1.Cells(i, 1)
s5.Cells(i5, 2) = s1.Cells(i, 2)
s5.Cells(i5, 3) = s1.Cells(i, 3)
i5 = i5 + 1
End Select
Next i
s2.Cells(i2, 2) = i2
s3.Cells(i3, 2) = i3
s4.Cells(i4, 2) = i4
s5.Cells(i5, 2) = i5
End Sub
です。
さて質問問題に合わせて変えるべきところは
（１）I列のコードが増えるとCASE文を増やさないとならない。
（２）Sheet数も増やさなければならない。
（３）Ｈ列・Ｊ列・Ｋ列・Ｌ列の分はs5.Cells(i5, 3) = s1.Cells(i, 3)等の両方の３のところを適宜変えて増やしてください。受け列に合わせて列番号を変えて下さい。
（４）s5.Cells(i5, 2) = i5の２を適宜決めてください。
（５）ソートキーはI列に変更すること。
－－－－－
（対応していない点）
（１）列の増加に自動対応。
（２）I列のコード増加に自動対応。
（３）オンライン的に出来てない。
データを増やした時、即座に反応する式でない。

お礼

＞VBAでやって見ました。デフォルメしているので、下記でやって納得して、本番用に修正してください。
ひぇー（泣）。
私自身には、ほとんど変更できる技術がありませんでした。
スミマセン・・・どうしよう・・・。
↑と思いつつ、会社の同僚に見せたところ、ふむふむ言いながらやっておりましたので、明日にはきっと・・・（ニタッ）。

うまく作動するといいなと思います。
早々のご回答ありがとうございました。

回答No.1

Hageoyadi

１～６の６つくらいまででしたら、オートフィルタとマクロの記録でそれぞれ記録するのはどうでしょう。

集計行について。
先頭行に集計を持ってくるのは×でしょうか？
どうも教則本には集計を最終行に持ってくるキライがあるようですが、見易さを考えると集計は先頭に近いほうがいいかと思うのですが、どうでしょう？
どうしても最終行にとおっしゃるのなら、空白行がないことが条件ですが、「Ctrl+Shift+↓」で現在の列の最終行まで選択されますのでもう一回「↓」を押した場所にCOUNT系の関数を入力すればよいかと。

お礼

早々のお返事ありがとうございます。
集計行なのですが、どうしても最終行に作りたいのです。
私だけが使う表なら良いのですが、先方様と共有で使うファイルでして、
形式をこちらで変更するわけには行かないのです。
説明不足で失礼致しました。

また、現在、ＣＯＵＮＴＡを使用しております。

マクロで一瞬で作れたらいいなと思ったのでした。
またお力添えいただけるようでしたら、ご回答をお願いいたします。

追記）
これからご回答にある操作をやってみます。
うまく行くと良いですが・・・。