Sort/ transfer data

[joshua1990]

Hey guys!

I am just trying to structure my data and to collect records, which information is missing, in another table.

So far, I have copied to tblTwo with the following code, records, or rows, which did not empty the data in column A (empty).

    With tblExport.UsedRange
        .AutoFilter 1, ""
        With .Offset(1, 0).SpecialCells(12)
            .Copy tblTwo.Cells(tblTwo.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1)
            .Delete
        End With
        .AutoFilter 1
    End With 

However, I now have to expand the following conditions:

If column A = "" then cut and paste row after tblTwo.
If column D = "" then cut and paste row after tblTwo.
If column E, F, G or O = "" then cut and paste all rows of this class (class oriented to column D) after tblTwo.

The difficulty is that when columns E, F, G, or O are empty, these rows are transferred to tblTwo, but including the entire class.
In this case, the class / group is oriented to column D. Note, however, that this group should be located within the group of column C. Thus, there may be the same cells of the group from column D, but these belong to different classes from column C. Correspondingly, the entire class of column D is to be observed or transferred within the class of column c.

Does anyone have a meaningful approach to me or any suggestions?

[mana]

Option Explicit


Sub test2()
    Dim rngS As Range
    Dim rngC As Range
    Dim rngD As Range
    Dim v, i As Long
    
    Set rngS = tblExport.Range("A1").CurrentRegion.Resize(, 17)
    Set rngC = rngS.Resize(2, 1).Offset(rngS.Rows.Count + 2)
    rngC.Cells(2).Formula = "=OR(E2="""",F2="""",G2="""",O2="""")"
    
    Set rngD = rngC.Resize(1, 2).Offset(rngC.Rows.Count + 2)
    rngD.Value = rngS.Range("C1:D1").Value
    
    rngS.AdvancedFilter xlFilterCopy, rngC, rngD, True
    v = rngD.CurrentRegion.Value
    
    rngC.ClearContents
    rngD.CurrentRegion.ClearContents
    
    With tblExport.Range("A1").CurrentRegion.Resize(, 17)
        .AutoFilter 1, ""
        With .Offset(1)
            .Copy tblTwo.Cells(tblTwo.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1)
            .Delete
        End With
        .AutoFilter
    End With
    
    With tblExport.Range("A1").CurrentRegion.Resize(, 17)
        .AutoFilter 4, ""
        With .Offset(1)
            .Copy tblTwo.Cells(tblTwo.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1)
            .Delete
        End With
        .AutoFilter
    End With
    
    For i = 2 To UBound(v)
        With tblExport.Range("A1").CurrentRegion.Resize(, 17)
            .AutoFilter 3, v(i, 1)
            .AutoFilter 4, v(i, 2)
            With .Offset(1)
                .Copy tblTwo.Cells(tblTwo.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1)
                .Delete
            End With
            .AutoFilter
        End With
    Next
    
End Sub

[joshua1990]

Thank you for your response and your approach (:I would like to register at the latest Wednesday, if everything has worked

[joshua1990]

It's working perfect!
Many thanks (:I get a message saying I want to delete the rows. How can I disable this and declare it with positive?

[mana]

application.displayalerts=false
&
application.displayalerts=true

[joshua1990]

Many thanks!

[mana]

or

> .Delete

.Delete xlShiftUp