セルの値によって抽出条件を変更する

Question

前提・実現したいこと

同じフォルダ内の複数のブックから条件にあったデータを抽出して貼り付ける作業を
繰り返し行います。

（抽出の条件）
・H列に値がある且つI列に値がない場合

発生している問題・エラーメッセージ

別な条件でH列に値がない場合の抽出は問題なくできております。
しかし、H列に値がなく且つI列に値がないものも抽出されてしまいました。
ご指導よろしくお願いします。

該当のソースコード

Sub 抽出()

        Dim dstRNG As Range
        Dim ブック名 As String
        Dim sh As Worksheet
        Dim sh2 As Worksheet
        Dim ws As Worksheet
        Dim IRow As Long
        Dim i As Long


        On Error Resume Next
        
        Set sh2 = Worksheets("抽出" & Format(Date, "yyyymmdd"))

        On Error GoTo 0

         If sh2 Is Nothing Then

            Rows("22:22").Copy

            Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
            ws.Name = "抽出" & Format(Date, "yyyymmdd")
 
            Rows("4:4").Select
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
  
            ActiveSheet.Paste
            Application.CutCopyMode = False

         End If

        
       Set dstRNG = ws.Range("A5")


        ブック名 = Dir(ThisWorkbook.Path & "*.xls?")
        Do Until ブック名 = ""
            If ブック名 <> ThisWorkbook.Name Then
                With Workbooks.Open(ThisWorkbook.Path & "\" & ブック名)
                    For Each sh In .Worksheets

                       lRow = sh.Cells(sh.Rows.Count, 4).End(xlUp).Row
                       
                          If lRow >= 11 Then
                          
                            With sh.Rows("11:" & lRow)
                          
                        
                             .Copy dstRNG

                             Set dstRNG = dstRNG.Offset(.Rows.Count)
                             
                            End With
                        
                         End If
                        
                    Next sh


                    .Close False
                End With
            End If


            ブック名 = Dir()
        Loop
        
  
    lRow = Cells(Rows.Count, 4).End(xlUp).Row
    Application.ScreenUpdating = False
    

    For i = lRow To 5 Step -1
         If Cells(i, 8).Value <> "" Then
           If Cells(i, 9).Value <> "" Then
             Rows(i).Delete
           End If
         End If
    Next i
    
    
    Application.ScreenUpdating = True
    
            
        
    End Sub

Comments

[meg_]

まずは「H列に値がある」条件で抽出してみてはどうでしょうか？

[ichigo15]

申し訳ございません。
質問が少し間違っていましたので修正いたしました。

正しくは、H列に値がある且つI列に値がないものとH列に値がある且つI列に値がないものが抽出されています。

H列に値があるだけでしたら抽出は大丈夫です。

For i = lRow To 5 Step -1
If VarType(Cells(i, 8)) = vbEmpty Then
Rows(i).Delete
End If
Next i

Answer 1

試行錯誤しまして希望通りの抽出ができるようになりました。
ただ正しいかどうかは不安ですが。。。

ご回答いただきました皆様には感謝いたします。

 For i = lRow To 5 Step -1
         
         If VarType(Cells(i, 8)) = vbEmpty Then
           Rows(i).Delete
         End If
           If Cells(i, 9).Value <> "" Then
             Rows(i).Delete
           End If
         
    Next i