エクセルのマクロを教えてください

下記のコードで15列目を空白以外で絞ったときデータが1行しか無い場合、
.Range(.Range("O2"), .Range("O" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
これだとうまくコピーが出来ません。
絞るデータが無い、または1行しかない場合はどうすれば良いでしょうか？


With Sheets("Sheet1")
.Range("A1").AutoFilter Field:=15, Criteria1:="<>"
.Range(.Range("A2"), .Range("H" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("A:A").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues

.Range(.Range("O2"), .Range("O" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("I:I").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.ShowAllData
End With

No.2 ベストアンサー 回答者： tom04 回答日時： 2019/12/10 11:38

こんにちは！

オートフィルタを掛けるというコトは1行目が項目行になっているのですよね。
＞データが1行しか無い場合
とはデータが全くなく、項目行だけが表示されている状態ってことでしょうか？

一例です。
標準モジュールです。

Sub Sample1()
　Dim lastRow As Long, wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　With Worksheets("Sheet1")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　.Range("A1").AutoFilter field:=15, Criteria1:="<>"
　　　　　　If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then '//★//
　　　　　　　Range(.Cells(2, "A"), .Cells(lastRow, "A")).SpecialCells(xlCellTypeVisible).Copy
　　　　　　　　wS.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
　　　　　　　Range(.Cells(2, "O"), .Cells(lastRow, "O")).SpecialCells(xlCellTypeVisible).Copy
　　　　　　　　wS.Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
　　　　　　End If
　　　　　.AutoFilterMode = False
　　　　　Application.CutCopyMode = False
　　　End With
End Sub

こんな感じをお望みなのでしょうか？

※　的外れならごめんなさい。m(_ _)m

この回答へのお礼

ありがとうございます！

お礼日時：2019/12/10 15:44

No.3 回答者： Qchan1962 回答日時： 2019/12/10 13:28

＞.Range(.Range("O2"), .Range("O" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy

Rows.Count).End(xlUp)は、シートの最終行からO列でCtrl+↑を押下時のRowになります。
その値が、.Range("O2"、の2行（整数2）より小さいとエラーになります。従って、見出し行のみが表示されている場合や
O列に何も表示されていない場合に発生する事が予見できます。

対策は、目的によって変わってきます。
O列に何もデータが無いならCopyしなくて良いなら、エラーを飛ばし実行する　On Error Resume Next 　（この処理はしないが他の処理がしたい場合など）
O列にはデータはないが、他の列にデータがあり、Copyする場合は、条件書式　IFなどと変数を活用するなどしてRows.Count部分に　（この可能性もあるかと）
2以上を代入するなどですかね。

良く行われる例として行を変数にあらかじめ入れる

Dim lastRow As Long　’変数宣言

On Error Resume Next 　’エラーがある場合次に進む
lastRow = .Cells(Rows.Count, 15).End(xlUp).Row　’15はO列
　If lastRow <= 1 Then　’O列が空か見出し行（1行のみ）の時
　　If .Cells(2, 14) <> "" Then lastRow = 2　’N2にデータが無ければ lastRow = 2　＊.Cells(2, 14)の他の書き方　.Cells(2,"N") 　または、 .Range("N" & 2)
　End If
’上記条件でlastRowが1なら下記でエラーになり下記の処理を飛ばし次に進む
.Range(.Range("O2"), .Range("O" & lastRow).SpecialCells(xlCellTypeVisible).Copy

O列2行にデータなくN列2行目にデータがない場合は、処理をせず次に進み
O列2行目にデータがなくN列２行目にデータがある場合は、２行目がCopyされます。
O列2行目以降にデータがあれば、通常通り処理が進みます。

参考まで

この回答へのお礼

ご丁寧にありがとうございます。
とても参考になります。

お礼日時：2019/12/10 15:46

No.1 回答者： rukaandkaito 回答日時： 2019/12/10 10:54

同様の事象、記載のコードで既存データの削除を行おうとしたときに、エラーとなりはじかれました。

そのため当方では２行目（この場合３行目）が空白の場合には処理を行わないという判定を入れて回避しました。
--------------------------------------------------------------------------------
IF .Range("O3").value="" Then
Else
　.Range(.Range("O2"), .Range("O" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
End If
--------------------------------------------------------------------------------
力技かもしれませんがこれで回避できるのでお試しください

上記はコピー句の部分だけを記載していますが、３行目にデータが無い場合には全ての処理を行わない様にするのがベストだとは思います。