課題を提示したつもりが、upしていませんでした。
＞こんなスタンス・方針
何のことやら解りませんよね？私では力不足のようなので退散します。

もし、動作するようなら検討下さい。

Sub D列G列に値がある行の抽出()
    Const 列 = "J"  '表の最大列
    Dim shFrom As Worksheet, shTo As Worksheet
    Dim 表 As Range, rr As Range, r As Range, ra As Range
    Dim i As Long
    Dim アルファベット As String, c As String, jc As String, ja As String
    
    Set shFrom = Worksheets("Sheet1")
    Set shTo = Worksheets("Sheet2")
    shTo.UsedRange.ClearContents
    '表範囲を所得し、転記データがなければ終了
    Set 表 = shFrom.Range("A1", shFrom.Range("A1").End(xlDown)).Resize(, Cells(1, 列).Column)
    If WorksheetFunction.CountA(表.Range("d:d,f:f")) = 0 Then
        MsgBox "nothing"
        Exit Sub
    End If
    
    '表データをshToに貼り付け
    表.Copy
    shTo.Range("A2").PasteSpecial xlPasteValues '1行目は項目行として使用
    
    With shTo
        Application.Goto .Cells(1)  'セル1表示
        '並び戻しキー作成（作業列1）
        Set 表 = .UsedRange
        With 表.Offset(, 表.Columns.Count).Columns(1)
            .Cells(1).Value = 2
            .Cells(1).AutoFill .Cells, xlFillSeries
            .Cells(1).Offset(-1).Value = 1
        End With
        '選択キー作成（作業列2）
        With .UsedRange
            With .Offset(, .Columns.Count).Columns(1)
                Set rr = .Cells
                .Formula = "=D1&F1" 'D列かF列か両方かに値があれば
                .Value = .Value     'SpecialCells(xlCellTypeConstants)になる
            End With
        End With
        With .UsedRange
            'アルファベットで並び替え
            .Sort Range("A1"), xlAscending, Header:=xlYes
            For Each r In rr.SpecialCells(xlCellTypeConstants)  '選択キーが有るセルのみ繰り返す
                Set ra = r.EntireRow.Cells(1, "a")      '１列目
                アルファベット = ra.Value               'アルファベットは１列目の値
                If アルファベット <> ja Then jc = ""     'アルファベットが替わったら日本語記録クリア
                ja = アルファベット
                c = ra.Offset(, 2).Value
                If Not IsJapanese(c) Then   'C列の値が日本語以外なら
                    If jc = "" Then             '日本語記録無いなら
                        For i = r.Row - 1 To 1 Step -1  '上の行を検索繰り返し(Doと違い繰り返し制限可能)
                            Set ra = ra.Offset(-1)
                            If ra.Value <> アルファベット Then Exit For  'アルファベットが替わったら検索終了
                            If IsJapanese(ra.Offset(, 2).Value) Then
                                jc = ra.Offset(, 2).Value   '日本語なら日本語記録
                                Exit For                    'し、検索終了
                            End If
                        Next
                    End If
                Else
                    jc = c                  'C列の値が日本語なら日本語記録
                End If
                r.EntireRow.Cells(1, "C").Value = jc        'C列に日本語もしくは""を代入
            Next
            
            .Sort .Columns(.Columns.Count - 1), Header:=xlYes   '並び戻し
            .AutoFilter .Columns.Count, ""                  '選択キー無しでフィルター
            .EntireRow.Delete                               '表示されている行を削除
            .Columns(.Columns.Count - 1).Resize(, 2).ClearContents  '作業列クリア
        End With
    End With
End Sub

Function IsJapanese(ss As String) As Boolean
    Dim s As String
    IsJapanese = True           '漢字とする
    s = Left(ss, 1)                     '文字列の１文字目のみ検査
    If Not s Like "[亜-熙一-龠]" Then   '漢字以外（記号"々"は除く）なら
        s = StrConv(StrConv(s, vbWide), vbHiragana) '全角ひらがな化
        If Not s Like "[あ-わヴ]" Then  '全角ひらがな（一部"ァ"や"ゑ"などは除く）と"ヴ"以外なら
            IsJapanese = False  '漢字では無いとする
        End If
    End If
End Function