VBA 切り分けがうまくいかない

質問

A列のデータで切り分けるようプログラム作成しています。
あるデータをA列で切り分けることができましたが、切り分けた後のファイル内容を確認したら、E列以降の内容が元データと異なっていました。
E列にはプルダウンメニューを入れていますので、それが原因かと思い、プルダウンメニューを消した元データで切り分けてみましたが、解決できませんでした。
他のデータ（プルダウンなし・空欄なし）では問題なく正しい内容で切り分けることができています。
フルダウン入りや空欄があるデータだと、正確に切り分けることができないかどうかご教示いただけますと幸いです。

VBAを作った担当者は異動してしまったため、直すことができませんでした。
宜しくお願いします。

Sub Macro5()
'
' Macro5 Macro
'
Dim txtFilename As String '元のファイル名
Dim txtS As String '分類名保存用
Dim htxtS As String '定形文保存用

Dim cRow As Integer '行数カウント用
Dim sRow As Integer '行数保存用
Dim eRow As Integer '最終行格納用

Dim h As Integer 'データ入力行保管用
Dim j As Integer 'データ入力開始列
Dim i As Integer '分類項目列保管用
Dim e As Integer '分類項目最終行数保管

i = Cells(18, 9).Value '分類項目列取得
j = Cells(14, 9).Value 'データ入力開始列
h = Cells(14, 11).Value 'データ入力行取得
htxtS = Cells(21, 9).Value '定型文取得

'元ファイル名（＝同じフォルダ）を取得する
txtFilename = Dir(ThisWorkbook.Path & "¥*.xlsx")

'ファイルを開ける
Workbooks.Open ThisWorkbook.Path & "¥" & txtFilename
Sheets(1).Activate

'分類項目の最終行を取得する
e = Cells(h, i).End(xlDown).Row

'分類項目でソートを掛ける
Cells(h - 1, j).Activate
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
ActiveWorkbook.Worksheets(1).AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).AutoFilter.Sort.SortFields.Add Key:= _
Range(Cells(h - 1, i), Cells(e, i)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets(1).AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

sRow = 0
cRow = h
eRow = h

'対象項目の行が無くなるまで繰り返す
Do Until cRow > eRow

'対象シートを新しいブックに貼り付ける
Worksheets.Select
Worksheets.Copy
Sheets(1).Activate

' 項目名（＝ファイル名）の退避
Cells(h, i).Select
txtS = ActiveCell.Value '1つ目の分類項目を格納

' 最終行の取得
eRow = Cells(h - 1, i).End(xlDown).Row
cRow = h

'分類項目が変わるまで繰り返す
Do While txtS = Cells(cRow, i).Value
cRow = cRow + 1 '1行加算
Loop

'最終行が１行の時は削除されないように対象分類項目以下を削除をスキップする
If cRow <> eRow + 1 Then

'対象分類項目以下を削除
Rows(cRow & ":" & eRow).Select
Selection.Delete

End If

'対象分類の行数を保存
sRow = cRow - 1

'ファイル名を指定して保存
Cells(1, 1).Activate
Selection.AutoFilter
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "¥" & htxtS & txtS & ".xlsx" '元ファイルと同フォルダに保存する
.Close
End With

'元のファイルに戻りファイル作成済みの項目を削除
Windows(txtFilename).Activate
Sheets(1).Activate
ActiveWindow.SelectedSheets(1).Select
Rows(h & ":" & sRow).Select
Selection.Delete Shift:=xlUp
Cells(1.1).Activate

Loop

MsgBox ("ファイル分割処理が終了しました")
'元ファイルを保存せずに閉じる
Workbooks(txtFilename).Close SaveChanges:=False

End Sub

回答No.2

nishi6

VBAコードをあまり見ていないと書いたのは、質問の内容を把握できなかったからです。
あくまでもEndプロパティを使う場合の参考意見です。

＞A列のデータで切り分けるようプログラム作成しています。
まず、この行の意味が分かりません。万人に分かるように.書くべきでしょう。
A列にどのようなデータが入って、どのように切り分けるのでしょうか。
また、切り分けとは何でしょうか？

＞E列にはプルダウンメニューを入れていますので、それが原因かと思い
これも意味が分かりません。シートの概要とか、対象Bookの構造を示すべきでしょう。
プルダウンメニューがあるのはどのBookでしょうか。

＞フルダウン入りや空欄があるデータ
プルダウンとは入力規則のことですか？プルダウンセルは全て選択されているんでしょうか。全て文字列や数値が選択されていますか？
空欄とは未入力行のことですか？未入力セルのことですか？まさかスペース？

＞上記のように修正しましたが、エラーメッセージが出てしまいました。
データ内容もからず、こう書れても手が出ません。
データを明らかにし、エラーがどの行で起きたか示すべきでしょう。
そうされても解決できるか分かりませんが。

前回回答はあくまで、未入力セルがあるときのEndプロパティの引数の使い方がおかしいということの説明です。元のコードがそのようなデータを想定していないということになります。

お礼

説明不足ですみません。
マクロ処理するデータ「マクロ.xlsm」データ元「部署.xlsx」完成データ「完成.xlsx」
データ元
A列　　　B　　　C　　　　　D　　　E（プルダウンメニュー）
人事　　鈴木　　生年月日　　住所　　血液型A
総務　　山田　　生年月日　　住所　　血液型B
企画　　高橋　　生年月日　　住所　　血液型不明
人事　　田中　　生年月日　　住所　　（空欄）
人事　　小島　　生年月日　　住所　　血液型B
企画　　山本　　生年月日　　住所　　血液型B
総務　　斉藤　　生年月日　　住所　　血液型A
※E列のプルダウンメニュー
https://office-hack.com/excel/pulldown-menu/
プルダウンメニューの内容（5個）
・血液型A・血液型B・血液型O・血液型AB・血液型不明

「マクロ.xlsm」で処理すると「完成.xlsx」は以下になるものです。
切り分けとはA列の部署によって切り分けるということです。
A列　　　B　　　C　　　　　D　　　E（プルダウンメニュー）
人事　　鈴木　　生年月日　　住所　　血液型A
人事　　田中　　生年月日　　住所　　（空欄）
人事　　小島　　生年月日　　住所　　血液型B
総務　　山田　　生年月日　　住所　　血液型B
総務　　斉藤　　生年月日　　住所　　血液型A
企画　　高橋　　生年月日　　住所　　血液型不明
企画　　山本　　生年月日　　住所　　血液型B

となるのですが、空欄があると下のデータが繰り上げてしまうのです。
A列　　　B　　　C　　　　　D　　　E（プルダウンメニュー）
人事　　鈴木　　生年月日　　住所　　血液型A
人事　　田中　　生年月日　　住所　　血液型B
人事　　小島　　生年月日　　住所　　血液型B　
総務　　山田　　生年月日　　住所　　血液型A
総務　　斉藤　　生年月日　　住所　　血液型不明
企画　　高橋　　生年月日　　住所　　血液型B
企画　　山本　　生年月日　　住所
となってしまい、正確なデータができてないのです。

宜しくお願いします。

回答No.1

nishi6

VBAコードはあまり見ていません。ファイルの中身が分からないので、あくまで想像です。ご容赦を。当方Excel2010です。

空欄があるとうまくいかないということをヒントに考えてみました。
コードには「RangeオブジェクトのEndプロパティ」が４カ所使われています。
Endプロパティの引数が「xlDown」、「xlToRight」なので、上から下、または左から右のセルの途中に空欄があると意図した領域が選択できません。

空欄がある場合の最終セルを求めるには、行の場合は一番下から「xlUp」で上に向かって調べます。
列の場合も、右端から「xlToLeft」で左に向かって調べます。
下のコードはその辺を考慮しています。

しかし、最終行や最終列に空欄があって、その列や行で範囲を決める場合、正しくも求まらない場合があります。添付図のA列、C列、8行目のような例です。
データ内容が分からないので判断付きかねますが、最悪、各列の最下段、各行の最右セルの最大値を求める必要があるかもしれません。
この辺りはいくらがんばっても何が起きるか分からないので、データの構造を工夫して、「Selection.CurrentRegion.Select」等が使えるようにするのが賢明だと思います。

　　'分類項目の最終行を取得する
　 'e = Cells(h, i).End(xlDown).Row　　　　　 '// 元
　　e = Cells(Rows.Count, i).End(xlUp).Row '// 修正

　　'分類項目でソートを掛ける
　　Cells(h - 1, j).Activate
　 'Range(Selection, Selection.End(xlToRight)).Select '// 元
　　Range(Selection, Cells(h - 1, Columns.Count).End(xlToLeft)).Select '// 修正
　 'Range(Selection, Selection.End(xlDown)).Select '// 元
　　Range(Selection, Cells(Rows.Count, j).End(xlUp)).Select '// 修正

　　'最終行の取得
　 'eRow = Cells(h - 1, i).End(xlDown).Row '// 元
　　eRow = Cells(Rows.Count, i).End(xlUp).Row '// 修正

お礼

コメントをありがとうございます。
上記のように修正しましたが、エラーメッセージが出てしまいました。

実行時エラー'1004'
'Select'メソッドは失敗しました 'Sheets'オブジェクト