copy filtered data naar nieuwe worksheet

[SandyH]

Goeiemiddag,

Ik heb onderstaande code, deze werkt goed om een eenvoudig bereik te kopieren naar een nieuwe worksheet, echter wil ik in de nieuwe worksheet graag gefilterde data

Ik heb nu range A13 tem S157 gekopieerd en geplakt naar een nieuwe worksheet, maar ik heb enkel een aantal kolommen nodig (die niet allemaal aaneensluitend zijn, en dan is er ook een filter op de laatste kolom waarbij de nulwaarden er uitgefilterd zijn).
(Ik heb kolommen A G I K M O Q S nodig, en op kolom S staat een filter waarbij de 0 waarden in deze kolom eruit gefilterd worden.

Waar (en hoe) moet ik dat ergens tussenvoegen ?
In het copy range gedeelte, of het paste gedeelte ?

Sub proposal()
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet

    '~~> Source/Input Workbook
    Set wbI = ActiveWorkbook
    '~~> Set the relevant sheet from where you want to copy
    Set wsI = wbI.Sheets("Voorstel MTO")

    '~~> Destination/Output Workbook
    Set wbO = Workbooks.Add

    With wbO
        '~~> Set the relevant sheet to where you want to paste
        Set wsO = wbO.Sheets("Sheet1")

        '~~>. Save the file
        wbO.SaveAs Filename:="V:\Supply Chain Team\Proposal" & _
        Format(Date, " dd-mm-yyyy") & ".xlsx", FileFormat:=56

        '~~> Copy the range
        wsI.Range("A13:S157").copy

        '~~> Paste it in say Cell A1. Change as applicable
        wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End With
End Sub

alvast bedankt !

 

[snb]

Ken je al het verschil tussen worksheet en workbook ?
Heb je deze code wel zelf gemaakt ?
Wat heb je zelf al aan oplossingen geprobeerd ?
Waar loop je dan precies vast ?

 

[JEC.]

Probeer dit eens

Sub jec()
 Dim r As Range, c As Range
 Application.DisplayAlerts = False
 Application.ScreenUpdating = False
 Set r = Workbooks.Add.Sheets(1).Range("A1").Resize(2, 8)
 Set c = r.Offset(, 8).Resize(2, 1)
 r.Resize(1) = Array("Reference", "Pcs/Palet", "16.01.23 Qty", "17.01.23 Qty", "18.01.23 Qty", "19.01.23 Qty", "20.01.23 Qty", "# Pal")
 c.Value = Application.Transpose(Array("# Pal", "<>0"))
 ThisWorkbook.Sheets("Voorstel MTO").Range("A13").CurrentRegion.AdvancedFilter 2, c, r
 c.ClearContents
 Application.DisplayAlerts = True
End Sub

 

[snb]

Sub M_snb()
 With Sheets("Voorstel MTO").cells(13,1).CurrentRegion
   .Offset(, .Columns.Count + 2).Resize(2, 1) = Application.Transpose(Array("# Pal", "<>0"))
   .AdvancedFilter 2, .Offset(, .Columns.Count + 2).Resize(2, 1), Workbooks.Add.Sheets(1).Cells(1)
   .Offset(, .Columns.Count + 2).Resize(2, 1).ClearContents
  End With
End Sub

 

[JEC.]

Ik heb kolommen A G I K M O Q S nodig

 

[snb]

Hoe eenvoudig de overige handmatig te verwijderen.

 

[JEC.]

Hoe makkelijk als het gewoon automatisch gaat met advancedfilter, welke al wordt gebruikt

 

[snb]

Je hebt gelijk, maar eigenlijk is het een overbodige vraag , omdat het om gegevens uit een ander bestand gaat die met een querytable kunnen worden opgevraagd en beperkt tot de gewenste velden/kolommen.

 

[JEC.]

Ik zou het inderdaad ook liever zien via een query. En dan met name Power Query.

 

[snb]

Ik denk niet dat er veel verschil is tussen een Querytable en Powerquery: de techniek op de achtergrond is ADODB, alleen de userinterface is anders.

 

[SandyH]

Goeiemorgen,

Bedankt voor jullie reacties, ik was een weekendje in Maastricht, ik ga vandaag eens kijken naar jullie antwoorden.

Om te antwoorden op de vraag van SNB : ik heb deze code idd niet zelf geschreven, ik zoek via google hulp voor de dingen die ik wil proberen, en toevallig vond ik deze code, die ik dan gebruikt heb, ik probeer dan ook wel uit de code te leren, en ik kijk hoe ze opgesteld is, dus niet blindelings copy and paste, maar ook proberen er iets van op te steken zodat ik het in de toekomst zelf kan schrijven, net zoals ik nu ook de aangegeven codes door jullie zal uitprobreren én kijken hoe het ineen zit, zodat ik eruit kan leren hoe het moet.

Bedankt alvast en ik laat jullie nog iets weten

 

[SandyH]

Probeer dit eens

Sub jec()
 Dim r As Range, c As Range
 Application.DisplayAlerts = False
 Application.ScreenUpdating = False
 Set r = Workbooks.Add.Sheets(1).Range("A1").Resize(2, 8)
 Set c = r.Offset(, 8).Resize(2, 1)
 r.Resize(1) = Array("Reference", "Pcs/Palet", "16.01.23 Qty", "17.01.23 Qty", "18.01.23 Qty", "19.01.23 Qty", "20.01.23 Qty", "# Pal")
 c.Value = Application.Transpose(Array("# Pal", "<>0"))
 ThisWorkbook.Sheets("Voorstel MTO").Range("A13").CurrentRegion.AdvancedFilter 2, c, r
 c.ClearContents
 Application.DisplayAlerts = True
End Sub

Ik had een vereenvoudigd voorbeeld gegeven, maar achter de waardes in kolommen waar een datum staat, zit een formule verscholen, dus de datum wordt iedere week aangepast, en is geen vaste waarde.
Hoe kan ik de waardes in de array ingeven zodat er in de kolommen met datum steeds de juiste datum zal worden gegeven ?

Hopelijk is mijn vraag wat duidelijk ? Ik heb gans de namiddag al zitten zoeken op verschillende sites naar uitleg over arrays maar ik vind niet echt wat ik in wil bereiken.

 

[snb]

zie https://www.snb-vba.eu/VBA_Arrays.html

 

[JEC.]

Test dit eens. Ik zou ook zeker kijken naar Power Query.

Sub jec()
 Dim r As Range, c As Range, sh As Worksheet
 Application.DisplayAlerts = False
 Application.ScreenUpdating = False
 Set sh = ThisWorkbook.Sheets("Voorstel MTO")
 Set r = Workbooks.Add.Sheets(1).Range("A1").Resize(2, 8)
 Set c = r.Offset(, 8).Resize(2, 1)
 r.Resize(1) = Array(sh.[a13], sh.[g13], sh.[i13], sh.[k13], sh.[m13], sh.[o13], sh.[q13], sh.[s13])
 c.Value = Application.Transpose(Array("# Pal", "<>0"))
 sh.Range("A13").CurrentRegion.AdvancedFilter 2, c, r
 c.ClearContents
 Application.DisplayAlerts = True
End Sub

 

[SandyH]

Bedankt, dit helpt me veel verder ! nu nog een opmaakje eropzwieren en ik kan verder naar een volgende stap in mijn 'project'.
Ik ga zeker ook eens in die Powerquery duiken, maar eerst deze file volledig ombouwen