• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Excel bepaalde gegevens overzetten naar werblad

Status
Niet open voor verdere reacties.
Y

Yesper

Gebruiker
Lid geworden
9 apr 2021
Berichten
141
Hallo,

Kan iemand mij helpen met de onderstaande vraag.

1 De gegevens staan in tabblad (Hersteld_Blad1).
2 Kolom D is de selectie waarvan alleen de rijen met Centrale Bezorging, en Fijndistributie Belgie gekopieerd worden naar werkblad.
verder zouden de volgende kolommen A;C;D;E;F;G;I;J;K;M . de rijen mee gekopieerd moeten worden naar het werkblad.

Opmerking*

1 het tabblad Hersteld_Blad1 kan wel uit meer dan 1000 regels bestaan.


zie bijgevoegd bestand
 

Bijlagen

Bekijk dit eens
Werkt echter alleen als je de nieuwste versie van excel hebt.
 

Bijlagen

Beste

helaas heb ik versie 2010, mischien dat je daar ook iets voor hebt o.a een macro of...
 
In je voorbeeld staan meer kolommen. Dit komt overeen met de vraag in je openingspost

Code: 
Sub jec()
 Dim ar As Variant, i As Long
 ar = Sheets(1).Cells(1, 1).CurrentRegion
 
 With CreateObject("scripting.dictionary")
   For i = 1 To UBound(ar)
     If ar(i, 5) = 9100 Or ar(i, 5) = 7003 Or i = 1 Then
        .Item(.Count) = Array(ar(i, 1), ar(i, 3), ar(i, 4), ar(i, 5), ar(i, 6), ar(i, 7), ar(i, 9), ar(i, 10), ar(i, 11), ar(i, 12))
     End If
   Next
   Sheets(2).Cells(1, 1).Resize(.Count, 10) = Application.Index(.Items, 0, 0)
 End With
End Sub
 
Laatst bewerkt:
JVeer zei:
In je voorbeeld staan meer kolommen. Dit komt overeen met de vraag in je openingspost

Code: 
Sub jec()
 Dim ar As Variant, i As Long
 ar = Sheets(1).Cells(1, 1).CurrentRegion
 
 With CreateObject("scripting.dictionary")
   For i = 1 To UBound(ar)
     If ar(i, 5) = 9100 Or ar(i, 5) = 7003 Or i = 1 Then
        .Item(.Count) = Array(ar(i, 1), ar(i, 3), ar(i, 4), ar(i, 5), ar(i, 6), ar(i, 7), ar(i, 9), ar(i, 10), ar(i, 11), ar(i, 12))
     End If
   Next
   Sheets(2).Cells(1, 1).Resize(.Count, 10) = Application.Index(.Items, 0, 0)
 End With
End Sub
Klik om te vergroten...

Zover ik kan zien werkt deze prima, mag ik U beide danken voor de medewerken.
 
Mooizo!:thumb:
 
Betere data in de kolommen E, F en G.
Code: 
Sub hsv()
With Sheets(1).Cells(1).CurrentRegion
 .AutoFilter 5, 7003, xlOr, 9100
 Application.Union(.Columns(1), .Columns(3).Resize(, 5), .Columns(9).Resize(, 4)).Copy Sheets(2).Cells(1)
 .AutoFilter
End With
End Sub
 
Aanvulling op mijn vraag

Heb de gegevens in de macro gezet wat prima werkt.

Heb de gegevens die uit de kolom 14 (Kolom N) via zie onderstaand ingevoerd.

Sub jec()
Dim ar As Variant, i As Long
ar = Sheets(1).Cells(1, 1).CurrentRegion

With CreateObject("scripting.dictionary")
For i = 1 To UBound(ar)
If ar(i, 4) = "CENTRALE BEZORGING" Or ar(i, 4) = "FIJNDISTRIBUTIE BELGIE" Or i = 1 Then
If ar(i, 14) = "2" Or ar(i, 14) = "3" Or ar(i, 14) = "4" Or ar(i, 14) = "7" Or ar(i, 14) = "8" Or ar(i, 14) = "33" Or ar(i, 14) = "38" Or ar(i, 14) = "39" Or ar(i, 14) = "49" Or ar(i, 14) = "50" Or ar(i, 14) = "21" Or ar(i, 14) = "76" Or ar(i, 14) = "77" Or ar(i, 14) = "80" Or ar(i, 14) = "85" Or ar(i, 14) = "86" Or ar(i, 14) = "89" Or ar(i, 14) = "90" Or ar(i, 14) = "91" Or ar(i, 14) = "74" Or ar(i, 14) = "45" Or i = 1 Then
.Item(.Count) = Array(ar(i, 1), ar(i, 3), ar(i, 4), ar(i, 5), ar(i, 6), ar(i, 7), ar(i, 9), ar(i, 10), ar(i, 11), ar(i, 13),ar(i, 17))
End If
Next

Sheets(2).Cells(1, 1).Resize(.Count, 10) = Application.Index(.Items, 0, 0)
End With
End Sub

Krijg ik een foutmelding van compileerfout op de gegevens van Next zonder For


Zou het verder mogelijk zijn om kolom Q dus kolom 17 ook met het overzetten alleen de laatste cijfers (rechts), dus achter de - alleen in de kolom te zetten.

Zou heel blij zijn als iemand dit zou kunnen oppakken
 
Laatst bewerkt:
Als je de headers even van tevoren invult, zou dit het zijn.

Code: 
Sub jec()
 Dim ar As Variant, i As Long
 ar = Sheets(1).Cells(1, 1).CurrentRegion
 sq = Array(2, 3, 4, 7, 8, 33, 38, 39, 49, 50, 21, 76, 77, 80, 85, 86, 89, 90, 91, 74, 45)
 
 With CreateObject("scripting.dictionary")
   For i = 2 To UBound(ar)
     If ar(i, 5) = 9100 Or ar(i, 5) = 7003 Then
       If IsNumeric(Application.Match(ar(i, 14), sq, 0)) Then
          .Item(.Count) = Array(ar(i, 1), ar(i, 3), ar(i, 4), ar(i, 5), ar(i, 6), ar(i, 7), ar(i, 9), ar(i, 10), ar(i, 11), ar(i, 13), Split(ar(i, 17), "-")(1))
       End If
     End If
   Next
   Sheets(2).Cells(2, 1).Resize(.Count, 11) = Application.Index(.Items, 0, 0)
 End With
End Sub
 
Voor de juiste data.
Code: 
clng(ar(i, 6)), clng(ar(i, 7)), clng(ar(i, 9))
 
Doordat de data omgedraaid wordt (USA).
11-1-2022 wordt 1-11-2022 in de code van JVeer.

Vergeet CLng, ik had niet gezien dat er ook tijden in vermeld stonden en over naar CDec.

De regel die je aan moet passen is:
Code: 
.Item(.Count) = Array(ar(i, 1), ar(i, 3), ar(i, 4), ar(i, 5), [COLOR=#ff0000]cdec(ar(i, 6)), cdec(ar(i, 7)), cdec(ar(i, 9))[/COLOR], ar(i, 10), ar(i, 11), ar(i, 13), Split(ar(i, 17), "-")(1))


Een snellere methode bij meerdere dat is.
Code: 
Sub jec_hsv()
 Dim ar As Variant, i As Long
 ar = Sheets(1).Cells(1, 1).CurrentRegion
 
 With CreateObject("scripting.dictionary")
   For i = 2 To UBound(ar)
     If ar(i, 5) = 9100 Or ar(i, 5) = 7003 Then
       Select Case ar(i, 14)
        Case 2 To 4, 7, 8, 21, 33, 38, 39, 45, 49, 50, 74, 76, 77, 80, 85, 86, 89 To 91 'of Case 2, 3, 4, 7, 8, 21, 33, 38, 39, 45, 49, 50, 74, 76, 77, 80, 85, 86, 89, 90, 91
          .Item(.Count) = Array(ar(i, 1), ar(i, 3), ar(i, 4), ar(i, 5), CDec(ar(i, 6)), CDec(ar(i, 7)), CDec(ar(i, 9)), ar(i, 10), ar(i, 11), ar(i, 13), Split(ar(i, 17), "-")(1))
       End Select
     End If
   Next
   Sheets(2).Cells(2, 1).Resize(.Count, 11) = Application.Index(.Items, 0, 0)
 End With
End Sub
 
HSV zei:
Doordat de data omgedraaid wordt (USA).
11-1-2022 wordt 1-11-2022 in de code van JVeer.

Vergeet CLng, ik had niet gezien dat er ook tijden in vermeld stonden en over naar CDec.

De regel die je aan moet passen is:
Code: 
.Item(.Count) = Array(ar(i, 1), ar(i, 3), ar(i, 4), ar(i, 5), [COLOR=#ff0000]cdec(ar(i, 6)), cdec(ar(i, 7)), cdec(ar(i, 9))[/COLOR], ar(i, 10), ar(i, 11), ar(i, 13), Split(ar(i, 17), "-")(1))


Een snellere methode bij meerdere dat is.
Code: 
Sub jec_hsv()
 Dim ar As Variant, i As Long
 ar = Sheets(1).Cells(1, 1).CurrentRegion
 
 With CreateObject("scripting.dictionary")
   For i = 2 To UBound(ar)
     If ar(i, 5) = 9100 Or ar(i, 5) = 7003 Then
       Select Case ar(i, 14)
        Case 2 To 4, 7, 8, 21, 33, 38, 39, 45, 49, 50, 74, 76, 77, 80, 85, 86, 89 To 91 'of Case 2, 3, 4, 7, 8, 21, 33, 38, 39, 45, 49, 50, 74, 76, 77, 80, 85, 86, 89, 90, 91
          .Item(.Count) = Array(ar(i, 1), ar(i, 3), ar(i, 4), ar(i, 5), CDec(ar(i, 6)), CDec(ar(i, 7)), CDec(ar(i, 9)), ar(i, 10), ar(i, 11), ar(i, 13), Split(ar(i, 17), "-")(1))
       End Select
     End If
   Next
   Sheets(2).Cells(2, 1).Resize(.Count, 11) = Application.Index(.Items, 0, 0)
 End With
End Sub
Klik om te vergroten...

Beste, alle die mij hierin bijgestaan hebben. Zover ik kan zien werkt hij prima.
Zal hem maandag in de praktijk testen, thx
 
Importeren van bestand gegevens via Macro of.....

Beste ,

Het basis bestand waar eerder de gegevens uit voortkomen zou ik ook graag automatisch willen ophalen via een macro.

Het basis bestand heet H:\dagplanning\dagplanning DC1\Dagplanning productie beneden\Acces\MedeaOrderpick.xlsx , met een tabblad genaamd Hersteld_Blad1.
De gegevens zouden overgezet moeten worden naar H:\dagplanning\dagplanning DC1\Dagplanning productie beneden\Acces\TimeMedeaOrderpick.xslm en weggeschreven worden op tabblad Hersteld_Blad2.

Verder zitten er geen voorwaarde of dergelijke aan.

Wie kan me daarmee helpen.

Alvast dank voor alle hulp
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan