• 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.

Melding voorzien indien LKxxx niet in lijst voorkomt

Status
Niet open voor verdere reacties.
Danny,

Helaas had ik er geen zin in; het is monnikenwerk om al die begrippen te onderscheiden daar je nergens naar kolommen verwijst.
Omdat er niemand reageert heb ik maar een poging gedaan.

Code: 
Sub hsv()
Dim arr, i As Long, ii As Long, x As Long
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.path & "\Output.xlsx"
 'With GetObject(ThisWorkbook.path & "\Output.xlsx")
 With ActiveWorkbook
  For i = 1 To 3
  arr = Split(ThisWorkbook.Sheets(i).Name, "_")
   With Workbooks("Output Danny.xlsx").Sheets("Rawdata")
    With .Cells(1).CurrentRegion
     
     For x = 0 To 1
     If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
       .AutoFilter 1, CDate(ThisWorkbook.Sheets(i).Cells(1, 3).Value)
         Select Case x
            Case 0
                   .AutoFilter 7, "WPL ELE"
                   .AutoFilter 5, arr(0), 2, arr(1)
                   .Offset(1).Copy ThisWorkbook.Sheets(i).Range("A28")
            Case 1
                   .AutoFilter 7, "WPL MEC"
                   .AutoFilter 5, arr(0), 2, arr(1)
                   .Offset(1).Copy ThisWorkbook.Sheets(i).Range("A38")
          End Select
       Next x
    End With
   End With
Next i
.Close 0
End With
End Sub
 
Beste HSV,

Bedankt voor je geduld om toch even te kijken.
Zo te zien zitten we op de goede weg.

We zoeken eerst de eerste en laatste 4 karakters van het tabblad waar we in staan, RM-1_RE-1 in dit geval RM-1 en RE-1
Dit kunnen we vinden door
Code: 
    mySheetName = ActiveSheet.Name
    If Right(mySheetName, 4) = "RE-1" Then

Dan filteren we in de output op volgende:

Code: 
                   AutoFilter 1, "2/1/2016" (deze datum komt van cel C2 planning test xslm)
                   AutoFilter 6, "GT-SP-WKSE-15"
                   AutoFilter 5, "RE-1" (omdat Right(mySheetName, 4) = "RE-1" is)

Als dit gefilterd is dan worden volgende kolommen met gegevens van output naar planning test gekopieërd.

kolom C naar kolom A
kolom I naar kolom A
kolom J naar kolom A
kolom E naar kolom A
kolom M naar kolom A
kolom P is afhankelijk van de datum bovenaan naar kolom J
kolom B naar kolom K
kolom H naar kolom N

Het lijkt ingewikkeld maar voor ons is dit simpel omdat we hier alle dagen met werken.
Als je het niet ziet zitten, geen probleem.

Deze code is eens geschreven door programmeurs op ons werk, kan deze wel geven maar dan moet ik eerst de beveiliging kraken in VBA.

Grts Danny147
 
Hallo Danny.

Ik filter eerst op:
Code: 
[COLOR=#3E3E3E] .AutoFilter 1, CDate(ThisWorkbook.Sheets(i).Cells(1, 3).Value)[/COLOR]
Daarna split ik de werkbladnaam op "_" (arr(0) en arr(1)) →
Code: 
[COLOR=#3E3E3E].AutoFilter 5, arr(0), 2, arr(1)[/COLOR]

Dan moet ik filter 7 laten vallen en filteren op kolom 6.
Ik zal er binnenkort nog eens induiken.
 
Zo beter?
Code: 
Sub hsv()
Dim arr, i As Long, ii As Long, x As Long
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.path & "\Output Danny.xlsx"
 'With GetObject(ThisWorkbook.path & "\Output Danny.xlsx")
 With ActiveWorkbook
  For i = 1 To 3
  arr = Split(ThisWorkbook.Sheets(i).Name, "_")
   With Workbooks("Output Danny.xlsx").Sheets("Rawdata")
    With .Cells(1).CurrentRegion
     
     For x = 0 To 1
     If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
       .AutoFilter 1, CDate(ThisWorkbook.Sheets(i).Cells(1, 3).Value)
         Select Case x
            Case 0
                   .AutoFilter 6, "GT-SP-WKSE-15"
                   .AutoFilter 5, arr(0), 2, arr(1)
                   .Offset(1).Copy ThisWorkbook.Sheets(i).Range("A28")
            Case 1
                   .AutoFilter 6, "GT-SP-WKSM-15"
                   .AutoFilter 5, arr(0), 2, arr(1)
                   .Offset(1).Copy ThisWorkbook.Sheets(i).Range("A38")
          End Select
       Next x
    End With
   End With
Next i
.Close 0
End With
End Sub
 
Ik krijg keurig de overeenkomstige waarden in de rijen.
 
Beste HSV,

Weet niet wat er fout loopt ?

Het ene bestand noemt Planning Test.xlsm en het andere Output Danny.xlsx, beide staan op het bureaublad
De code heb ik een module gestoken en laten lopen via Alt F8 en HSV uitvoeren.

In het bestandje zie je dat er iets gebeurt want de cellen zijn niet meer omrand.
Het bestandje Output Danny.xlsx staat niet open voor de uitvoering start.

Zijn de benamingen niet goed of de plaats waar het staat ?

Grts Danny147
 
Hallo Danny,

Ik heb ook beide bestanden voor het gemak op het bureaublad (waar ze staan maakt niet uit, als ze maar in dezelfde map staan).
Bestandsnaam 'Output Danny.xlsx' is goed.
Als je de code doorloopt met F8 zie je dat in de taakbalk 'Output Danny' open gaat.
 

Bijlagen

Beste HSV,

Code doet het, maar de gegevens staan niet op de juiste plaats zoals vermeld op pagina #22 en hieronder

Als dit gefilterd is dan worden volgende kolommen met gegevens van output naar planning test gekopieerd.

kolom C naar kolom A
kolom I naar kolom B
kolom J naar kolom C
kolom E naar kolom H
kolom M naar kolom I
kolom O tot AN is afhankelijk van de datum bovenaan naar kolom J
kolom B naar kolom K
kolom H naar kolom N

Ook heb ik gezien dat alle tabbladen in één keer worden ingevuld.
Graag had ik dit per tabblad willen zien als ik de code laat lopen.

Grts Danny147
 
Wat moet er gebeuren met de tussenliggende kolommen; leeg laten?
Waarom staat de datum (O:AN) in het Duits (met punten)?
Waarom zo ingewikkeld?

Ik denk dat ik het maar voor gezien hou.
Succes.
 
Beste HSV,

Geen probleem als je het niet ziet zitten. :confused:
Vroeger was er nog een man of 5 à 6 die hun tanden hierin vastbijten, maar die tijd is blijkbaar gedaan.
HSV, Roncancio, Warme bakkertje, WIGI, enz...

Grts Danny147
 
Beste Danny,

Misschien als je mijn vragen nog eens wilt beantwoorden dat ik een mogelijkheid zie.
Verneem je niets, weet je het op voorhand.
 
Wat is het wachtwoord van je vba-project?
 
Beste HSV,

Volgens mij staat er geen wachtwoord in
Indien wel probeer eens met "ramdis"

Grts Danny147
 
Sommige objecten kent de bibliotheek niet.
Als ik op 'Verwijzingen' klik in het vba-project veaagt het om een wachtwoord.
Het ligt volgens mij niet aan mijn Excel omgeving daar het bij andere bestanden wel werkt.
"ramdis" is helaas niet het goede ww.
 
@ HSV

Harry, het emailadres dat ik nog had van jou is niet meer geldig dus stuur mij eens een email, heb hier nog iets liggen om vba-wachtwoord te verwijderen
 
Rudi,

Ik heb het naar je verzonden.
De instellingen heb ik aangepast zodat ik ook even tijdelijk privéberichten kan ontvangen.
Als het niet lukt verneem ik het van je.
 
Beste HSV

ramdis.36
Welk bestand is het dat je wilt zien ?

Grts Danny147
 
Laatst bewerkt:
Helaas geen succes Danny.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan