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