Macro aanpassen

[Marsjahe]

Kan iemand deze macro zodanig aanpassen dat hij alle NIET lege cellen in 4 filtert en naar sheets MC copieert?

Sub manco()
Application.ScreenUpdating = 0
For i = 65 To 90
letter = Chr(i)
With Blad1.Range("A1", Blad1.Cells(Rows.Count, 25).End(xlUp))
.AutoFilter 4, "*" & letter & "*"
Sheets(letter).UsedRange.Clear
Application.Union(.Columns(4), .Columns(10), .Columns(21), .Columns(23)).Copy Sheets(letter).Range("A1")
.AutoFilter
End With
Next
End Sub

Kan helaas het bijbehorende bestand niet uploaden omdat het te groot is

 

[HSV]

Probeer het.

Sub manco()
With Blad1.Range("A1", Blad1.Cells(Rows.Count, 25).End(xlUp))
 .AutoFilter 4, "<>"
 .offset(1).Copy sheets("MC").cells(rows.count,1).end(3).offset(1)
 .AutoFilter
End With
End Sub

 

[Marsjahe]

HSV, dank, het werkt prima

 

[Marsjahe]

Beste Hsv,
De door jou gemaakte macro voldoet bij eenmalig gebruik, echter wanneer ik wijzigingen in het bestand aanbreng ( in 4 )neemt hij die bij een volgende keer niet mee.

 

[HSV]

Als het niets doet zijn alle cellen gevuld in kolom D.
Indien er cellen leeg zijn zet het de gegevens onder elkaar op het andere blad.

 

[Marsjahe]

De macro zet alle NIET lege cellen in kolom D netjes in de lijst op het andere blad, zoals ook de bedoeling is. Echter wanneer ik later NIET lege cellen alsnog leeg maak blijven die terug komen in de lijst.

 

[HSV]

De gefilterde rijen moeten dus verwijderd worden?

 

[Marsjahe]

Ik ben niet duidelijk geweest, denk ik. Het is de bedoeling dat de gefilterde lijst wordt vernieuwd als ik een volgende keer de macro weer gebruik. De cellen die ik ondertussen heb leeggemaakt moeten dan niet meer verschijnen.Eigenlijk net als een eerder door jou voor mij gemaakte macro moeten de lijsten steeds weer opnieuw gefilterd worden zodat ik kan zien wat er gewijzigd is.

 

[HSV]

Zo misschien?

Sub manco()
Set Sh = Sheets("mc")
With Blad1.Range("A1", Blad1.Cells(Rows.Count, 25).End(xlUp))
 .AutoFilter 4, "<>"
 .Offset(1).Copy IIf(Sh.Cells(1) = "", Sh.Cells(1), Sh.Cells(Rows.Count, 1).End(3).Offset(1))
 .AutoFilter
Sh.UsedRange.RemoveDuplicates Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16)
End With
End Sub

 

[Marsjahe]

Ja, dit werkt, graag nog een aanpassing zodat alleen de kolommen 4, 10, 12 en 14 wordt weergegeven. Ik hoop dat ik niet te veel vraag...

 

[HSV]

Dat stukje code had ik je al gegeven in je vorige vraag, misschien een beetje zelfstudie?
Als het niet lukt verneem ik het wel weer.