Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

52768 / 76732

←次へ　｜　前へ→


	【28794】Re:特定の条件で範囲を検索し他のセルにコピー

りん

- 05/9/14(水) 21:03 -


	引用なし

	パスワード

りょうたさん、こんばんわ。

>データが1件しかない場合や1件もない場合は
>おかしくなってしまいます。
それ以外にも、A5からオートフィルタをかけると、A5はタイトルとして無条件で貼り付け対象になるので修正しました。

Sub TEST()
　 Dim r1 As Range, r2 As Range
　 '
　 With Range("A4")
　　　Range(.Offset(0, 0), .Offset(1, 0).End(xlDown)).AutoFilter _
　　　　 Field:=1, Criteria1:=">=1000", Operator:=xlAnd, Criteria2:="<=1999"
　　　'
　　　If Not .End(xlDown).Row = .Parent.Rows.Count Then
　　　　 On Error Resume Next
　　　　 Set r1 = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)) _
　　　　　　　　　　　　　　　　　　　　　.SpecialCells(xlCellTypeVisible)
　　　　 On Error GoTo 0
　　　End If
　 End With
　 If Not r1 Is Nothing Then
　　　r1.Copy
　　　Range("D5").PasteSpecial xlPasteValues
　 Else
　　　MsgBox "該当なし", vbExclamation
　 End If
　 '
　 ActiveSheet.AutoFilterMode = False
　 Application.CutCopyMode = False
End Sub

こんな感じです。

0 hits

▼

【28745】特定の条件で範囲を検索し他のセルにコピー りょうた 05/9/13(火) 22:00