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

Gegevens wegschrijven dmv lijst.

Status
Niet open voor verdere reacties.
Voor het leesbaar houden. :)
Code:
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
For i = .Range("I2:I" & .Cells(Rows.Count, 10).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(i, 10) = "726.EW" Then .Cells(i, 1).Resize(, 11).Delete shift:=xlUp
 Next i
End With
 Dim wrksht As Worksheet
    For Each wrksht In Worksheets
      wrksht.Columns.AutoFit
    Next wrksht
    For i = 1 To 26
        Sheets("Blad" & i).Name = Choose(i, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle""Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "APVV", "APVG", "CPB", "Curatief")
    Next
    For x = 1 To 27
        Sheets(Choose(i, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle""Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "APVV", "APVG", "CPB", "Curatief", "In voorbereiding")).Range("A2").AutoFilter
    Next
 With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls")
 Workbooks.Open "D:\Lijst_LK's2.xls"
    With .Sheets("Samenvatting")
        Workbooks("Lijst_LK's2.xls").Sheets(1).Range("B2:F35").Copy .Range("B2")
        .Columns("A:F").ColumnWidth = 27.86
    End With
 Workbooks("Lijst_LK's2.xls").Close False
 Windows("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls").Activate
 With Application
    .ScreenUpdating = True
    .SheetsInNewWorkbook = 3
    .Save
    .Close True
 End With
 End With
End Sub
 
Beste HSV ;)

Deze morgend al getest en het ziet er fantastich uit :thumb:
Hier op mijn gewone laptop doet hij er 3min over. (3GB geheugen)

Op mijn andere zal het wat sneller gaan wat ik vanavond zal testen (8GB geheugen)

Ziehier het voltooide bestandje.

Groetjes Danny. :thumb:
 
Beste Warme bakkertje ;)

Fijn dat je nog even langs komt :d
Ik had meer van jou verwacht, maar HSV heeft mij al voortreffelijk geholpen :P

Heb jou stukje code uitgeprobeerd Rudi, maar hier en daar staat er een foutje en eentje waar ik niet verder mee geraak.

Code:
    For i = 1 To 2[B][COLOR="#FF0000"]8[/COLOR][/B]        Sheets("Blad" & i).Name = Choose(i, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle"[B][COLOR="#FF0000"],[/COLOR][/B] "Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "APVV", "APVG", "CPB", "Curatief"[B] [COLOR="#FF0000"], "In voorbereiding", "Samenvatting"[/COLOR] [/B])    Next
    For x = 1 To 27
        Sheets(Choose(i, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle"[B][COLOR="#FF0000"],[/COLOR][/B] "Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "APVV", "APVG", "CPB", "Curatief", "In voorbereiding")).Range("A2").AutoFilter

Omdat er tabblad Samenvatting niet was benoemd moest ik stoppen.

Probeer zelf nog wat aanpassingen te doen aan jouw code.

Groetjes Danny :thumb:
 
Code:
For i = 1 To 28
        Sheets("Blad" & i).Name = Choose(i, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle", "Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "APVV", "APVG", "CPB", "Curatief", "In voorbereiding", "Samenvatting")
    Next
    For x = 1 To 27
        Sheets(Choose([COLOR="#FF0000"]x[/COLOR], "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle", "Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "APVV", "APVG", "CPB", "Curatief", "In voorbereiding")).Range("A2").AutoFilter
    Next
 
Beste Warme bakkertje ;)

Aangepaste code nogmaals geprobeerd en het loopt gesmeerd :thumb: :D

Ziehier het laatste stukje code:

Code:
For i = .Range("I2:I" & .Cells(Rows.Count, 10).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(i, 10) = "726.EW" Then .Cells(i, 1).Resize(, 11).Delete shift:=xlUp
 Next i
End With
 Dim wrksht As Worksheet
    For Each wrksht In Worksheets
      wrksht.Columns.AutoFit
    Next wrksht
    For i = 1 To 28
        Sheets("Blad" & i).Name = Choose(i, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle", "Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "APVV", "APVG", "CPB", "Curatief", "In voorbereiding", "Samenvatting")
    Next
    For x = 1 To 27
        Sheets(Choose(i, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle", "Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "APVV", "APVG", "CPB", "Curatief", "In voorbereiding")).Range("A2").AutoFilter
    Next
 With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls")
 Workbooks.Open "D:\Lijst_LK's2.xls"
    With .Sheets("Samenvatting")
        Workbooks("Lijst_LK's2.xls").Sheets(1).Range("B2:F35").Copy .Range("B2")
        .Columns("A:F").ColumnWidth = 27.86
    End With
 Workbooks("Lijst_LK's2.xls").Close False
 Windows("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls").Activate
 With Application
    .ScreenUpdating = True
    .SheetsInNewWorkbook = 3
    .Save
    .Close True
 End With
 End With
End Sub

55 regels zijn herleid naar 9 regels, zonder returns is dit 5 :thumb:

Morgen zal ik deze op mijn werk testen en daarna de topic voor de 5x sluiten.

PS: Hij deed het met de i ook ipv van de x Rudi.

Groetjes Danny :thumb:
 
Laatst bewerkt:
Danny, zie post 124 voor aanpassing bij For x= 1 to 27 Sheets(Choose(x, ............)
Voor de rest zou het dan moeten werken zonder problemen.
 
Laatst bewerkt:
Beste Warme bakketje ;)

Zie PS: bij Post# 125, maar ik heb het aangepast.

Groetjes Danny. :thumb:
 
Beste HSV en warme bakkertje ;)

Om nog maar eens terug met de deur in huis te vallen , het volgende.

Ik probeer uit bestaande code nu de tabbladen te maken voor onze afdelingen op Sidmar.

Zie code, maar krijg foutmelding bij For Each cl In .Range("C2:C"...

Code:
Sub Uitvoeren_LKs_naar_afdelingen()
Application.ScreenUpdating = False
Application.SheetsInNewWorkbook = 9
Workbooks.Add

ActiveWorkbook.SaveAs "D:\LK-Kranen per afdeling " & Format(Date, "d-mm-yyyy") & ".xls"

Dim bestandopen
 bestandopen = Dir("D:\Danny\*")
    Do Until bestandopen = ""
      If bestandopen = "" Then Exit Do
        Workbooks.Open "D:\Danny\" & bestandopen
      With ActiveWorkbook.Sheets(1)
       .Range("B1:k" & .Cells.SpecialCells(xlLastCell).Row).Copy _
       Workbooks("LK-Kranen per afdeling " & Format(Date, "d-mm-yyyy") & ".xls").Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1)
      End With
        Application.DisplayAlerts = False
        Workbooks(bestandopen).Close True
      bestandopen = Dir
Loop
           
    With Workbooks("LK-Kranen per afdeling " & Format(Date, "d-mm-yyyy") & ".xls")
     With .Sheets(1)
        On Error Resume Next
            .Range("K2:K13000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
            .Range("B3:K13000").Sort Key1:=Range("C2"), Order1:=xlAscending
              Workbooks.Open "D:\Lijst_LK's per afdeling.xls"
                Workbooks("Lijst_LK's per afdeling.xls").Sheets("Blad1").Range("AA1").CurrentRegion.Copy .Range("AA1")
           For i = 1 To .UsedRange.Rows.Count 'rijen
                    For j = 1 To 11 'kolommen
                    .Cells(i, j) = RTrim(.Cells(i, j))
                    .Cells(i, 9) = Split(.Cells(i, 9))
                    .Cells(i, 8) = Split(.Cells(i, 8))
                Next j
                Next i
            For Each cdt In .Columns(9).SpecialCells(2)
                cdt.Value = Split(cdt.Value)
                If cdt Like "##-##-####" Or cdt Like "##-#-####" Or cdt Like "#-#-####" Or cdt Like "#-##-####" Then
                cdt.Value = DateValue(cdt)
                cdt.NumberFormat = "dd-mm-yyyy"
                End If
                Next cdt
               .Range("B2:K" & .Cells.SpecialCells(11).Row).AutoFormat Format:=xlRangeAutoFormatClassic1
               .Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
               .Columns.AutoFit
            End With
      Workbooks("Lijst_LK's per afdeling.xls").Close True
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

    Dim cl      As Range
    Dim C       As Variant
    Dim Rij     As Long

Application.ScreenUpdating = False
 sq = "Roepnaam" & "|" & "Machine" & "|" & "Omschrijving" & "|" & "Werkorder" & "|" & "Status" & "|" & "OnderhoudsType" & "|" _
 & "BeginTijdstipGepland" & "|" & "EindTijdstipGepland" & "|" & "CapacitaitsgroepID" & "|" & "Werkvoorbereider" & "|"


For Each cl In .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)

  If cl > 0 Then
       Set C = .Range("AA2:AH200").Find(cl, , xlValues, xlWhole)
       If Not C Is Nothing Then
    firstAddress = C.Address
    Do
    kolom = Mid(C.Address, 3, 1)
    Select Case kolom

 Case "A"
    With Sheets("Blad2").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad2")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad2").Columns("E:K").HorizontalAlignment = xlCenter
    End With

 Case "B"
    With Sheets("Blad3").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad3")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad3").Columns("E:K").HorizontalAlignment = xlCenter
    End With

 Case "C"
    With Sheets("Blad4").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad4")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad4").Columns("E:K").HorizontalAlignment = xlCenter
    End With

 Case "D"
    With Sheets("Blad5").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad5")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad5").Columns("E:K").HorizontalAlignment = xlCenter
    End With

 Case "E"
    With Sheets("Blad6").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad6")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad6").Columns("E:K").HorizontalAlignment = xlCenter
    End With

 Case "F"
    With Sheets("Blad7").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad7")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad7").Columns("E:K").HorizontalAlignment = xlCenter
        Sheets("Blad1").Columns("E:K").HorizontalAlignment = xlCenter
    End With

 Case "G"
    With Sheets("Blad8").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad8")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad8").Columns("E:K").HorizontalAlignment = xlCenter
        Sheets("Blad1").Columns("E:K").HorizontalAlignment = xlCenter
    End With

 Case "H"
    With Sheets("Blad9").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad9")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad9").Columns("E:K").HorizontalAlignment = xlCenter
    End With
        End Select
        Set C = .Range("AA2:AH200").FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
     End If
   End If
   If Not cl Is Nothing Then
naam = cl
   End If
 Next cl

For i = .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(i, 3) > 0 Then
       Set C = .Range("AA2:AH200").Find(.Cells(i, 3), , xlValues, xlWhole)
       If Not C Is Nothing Then
     .Cells(i, 3).Offset(, -2).Resize(, 11).Delete shift:=xlUp
   End If
  End If
 Next i
For i = .Range("I2:I" & .Cells(Rows.Count, 10).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(i, 10) = "726.EW" Then .Cells(i, 1).Resize(, 11).Delete shift:=xlUp
 Next i
End With
 Dim wrksht As Worksheet
    For Each wrksht In Worksheets
      wrksht.Columns.AutoFit
    Next wrksht
    For i = 1 To 9
        Sheets("Blad" & i).Name = Choose(i, "Rest", "HOS", "STL", "WWA", "KWA", "SDG", "DST", "ALD", "Onbekend")
    Next
    For x = 1 To 9
        Sheets(Choose(x, "Rest", "HOS", "STL", "WWA", "KWA", "SDG", "DST", "ALD", "Onbekend")).Range("A2").AutoFilter
    Next
 With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls")
 Workbooks.Open "D:\Lijst_LK's2.xls"
    With .Sheets("Samenvatting")
        Workbooks("Lijst_LK's2.xls").Sheets(1).Range("B2:F35").Copy .Range("B2")
        .Columns("A:F").ColumnWidth = 27.86
    End With
 Workbooks("Lijst_LK's2.xls").Close False
 Windows("LK-Kranen per afdeling " & Format(Date, "d-mm-yyyy") & ".xls").Activate
 With Application
    .ScreenUpdating = True
    .SheetsInNewWorkbook = 3
    .Save
    .Close True
 End With

 End With
End Sub
Kan je er eens na kijken wat ik fout heb gedaan ?

Groetjes Danny. :thumb:
 
Laatst bewerkt:
Als ik zo even het aantal 'With' en de 'End With' bekijk zoek je in bestand
'With Workbooks("LK-Kranen per afdeling " & Format(Date, "d-mm-yyyy") & ".xls")', maar geef je niet aan in welk blad.
De code loopt vast op de punt (.) voor Range("C.....
 
Laatst bewerkt:
Beste HSV ;)

Heb er dit voor geplaatst::

Code:
With Workbooks("LK-Kranen per afdeling " & Format(Date, "d-mm-yyyy") & ".xls")
    With .Sheets(1)

en op het einde 2 x End With bij geplaatst.

Nu voert hij de code perfect uit.

Groetjes Danny. :thumb:
 
Of de rode 'End With' op een andere plaats (lager in de code) zetten Danny.
Code:
For Each cdt In .Columns(9).SpecialCells(2)
                cdt.Value = Split(cdt.Value)
                If cdt Like "##-##-####" Or cdt Like "##-#-####" Or cdt Like "#-#-####" Or cdt Like "#-##-####" Then
                cdt.Value = DateValue(cdt)
                cdt.NumberFormat = "dd-mm-yyyy"
                End If
                Next cdt
               .Range("B2:K" & .Cells.SpecialCells(11).Row).AutoFormat Format:=xlRangeAutoFormatClassic1
               .Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
               .Columns.AutoFit
            [COLOR="#FF0000"]End With[/COLOR] 
     Workbooks("Lijst_LK's per afdeling.xls").Close True

Maar mooi dat het weer is opgelost.
 
Laatst bewerkt:
Beste HSV ;)

Bedankt hé :d

Groetjes Danny. :thumb:
 
Beste HSV ;)

Na maanden gewerkt te hebben, volgende foutmelding in het rood gekleurd.

Code:
Sub Uitvoeren_naar_AA_Kranen_origineel()
Application.ScreenUpdating = False
Application.SheetsInNewWorkbook = 30
Workbooks.Add

ActiveWorkbook.SaveAs "H:\Mijn documenten\LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx"

Dim bestandopen
 bestandopen = Dir("H:\Mijn documenten\Danny\*")
    Do Until bestandopen = ""
      If bestandopen = "" Then Exit Do
        Workbooks.Open "H:\Mijn documenten\Danny\" & bestandopen
      With ActiveWorkbook.Sheets(1)
       .Range("B1:k" & .Cells.SpecialCells(xlLastCell).Row).Copy _
       Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx").Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1)
      End With
        Application.DisplayAlerts = False
        Workbooks(bestandopen).Close True
      bestandopen = Dir
Loop
           
    With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx")
     With .Sheets(1)
        On Error Resume Next
            .Range("K2:K13000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
            .Range("B3:K13000").Sort Key1:=Range("C2"), Order1:=xlAscending
              Workbooks.Open "H:\Mijn documenten\Lijst_LK's.xls"
                Workbooks("Lijst_LK's.xls").Sheets("Blad1").Range("AA1").CurrentRegion.Copy .Range("AA1")
           For I = 1 To .UsedRange.Rows.Count 'rijen
                    For j = 1 To 11 'kolommen
                    .Cells(I, j) = RTrim(.Cells(I, j))
                    .Cells(I, 9) = Split(.Cells(I, 9))
                    .Cells(I, 8) = Split(.Cells(I, 8))
                Next j
                Next I
            For Each cdt In .Columns(9).SpecialCells(2)
                cdt.Value = Split(cdt.Value)
                If cdt Like "##-##-####" Or cdt Like "##-#-####" Or cdt Like "#-#-####" Or cdt Like "#-##-####" Then
                cdt.Value = DateValue(cdt.NumberFormat)
                cdt.NumberFormat = "dd-mm-yyyy"
                End If
                Next cdt
               .Range("B2:K" & .Cells.SpecialCells(11).Row).AutoFormat Format:=xlRangeAutoFormatClassic1
               .Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
               .Columns.AutoFit
            End With
      Workbooks("Lijst_LK's.xls").Close True
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

    Dim cl      As Range
    Dim C       As Variant
    Dim Rij     As Long
    
Application.ScreenUpdating = False
 sq = "Roepnaam" & "|" & "Machine" & "|" & "Omschrijving" & "|" & "Werkorder" & "|" & "Status" & "|" & "OnderhoudsType" & "|" _
 & "BeginTijdstipGepland" & "|" & "EindTijdstipGepland" & "|" & "CapacitaitsgroepID" & "|" & "Werkvoorbereider" & "|"
           
With Sheets("Blad7")
  .Range("A2") = "718.MEC"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37

 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, Criteria1:="718.1", Operator:=xlOr, Criteria2:="718.2"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("A3")
              End With
       .AutoFilter 9, Criteria1:="718.B1", Operator:=xlOr, Criteria2:="718.B2"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("C1500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 9, Criteria1:="718.ME"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad7").Range("C2000").End(xlUp).Offset(0, -2)
                Sheets("Blad7").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
          End With
          End With
With Sheets("Blad8")
  .Range("A2") = "718.ELE"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, Criteria1:="718.AB", Operator:=xlOr, Criteria2:="718.CD"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad8").Range("A3")
              End With
       .AutoFilter 9, Criteria1:="718.EL"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad8").Range("C1000").End(xlUp).Offset(0, -2)
                Sheets("Blad8").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
          
          End With
With Sheets("Blad9")
  .Range("A2") = "718.EXT"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, "718.EXT"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad9").Range("A3")
                Sheets("Blad9").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
With Sheets("Blad10")
  .Range("A2") = "726.KO"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, "726.KO"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad10").Range("A3")
                Sheets("Blad10").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
With Sheets("Blad11")
  .Range("A2") = "726.EW"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, "726.EW"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad11").Range("A3")
                Sheets("Blad11").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
With Sheets("Blad12")
  .Range("A2") = "718_VAST"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 9, "718_VAST"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad12").Range("A3")
                Sheets("Blad12").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
 With Sheets("Blad15")
  .Range("A2") = "Alg. Contr. van alle onderd."
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="*nische controle", Operator:=xlOr, Criteria2:="=*trole van alle onderd*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad15").Range("A3")
              End With
       .AutoFilter 3, Criteria1:="*trole Sifa"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad15").Range("C500").End(xlUp).Offset(0, -2)
                Sheets("Blad15").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
          
          End With
 With Sheets("Blad16")
  .Range("A2") = "Herstellingen na controle"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="=*lingen na con*", Operator:=xlOr, Criteria2:="=*sther*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad16").Range("A3")
              End With
       .AutoFilter 3, Criteria1:="=*ling na con*", Operator:=xlOr, Criteria2:="=*ling voor con*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad16").Range("C500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 3, Criteria1:="=*ling naar con*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad16").Range("C500").End(xlUp).Offset(0, -2)
                Sheets("Blad16").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
        End With
 With Sheets("Blad17")
  .Range("A2") = "Controle tonnenkoppelingen"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37

 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*trole tonnenkop*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad17").Range("A3")
                Sheets("Blad17").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
 With Sheets("Blad18")
  .Range("A2") = "Stroomafnemers"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*van de str*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad18").Range("A3")
                Sheets("Blad18").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
 With Sheets("Blad19")
  .Range("A2") = "Veiligheidsfunties"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*Veiligheidsfunctie*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad19").Range("A3")
                Sheets("Blad19").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
 With Sheets("Blad20")
  .Range("A2") = "Reinigen motoren"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="=*entie rei*", Operator:=xlOr, Criteria2:="=*entie fir*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad20").Range("A3")
                Sheets("Blad20").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
       
        End With
 With Sheets("Blad21")
  .Range("A2") = "Isolatiemetingen"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*na reini*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad21").Range("A3")
                Sheets("Blad21").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
              
        End With
 With Sheets("Blad22")
  .Range("A2") = "Smeren"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="smering", Operator:=xlOr, Criteria2:="=*eren en ol*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad22").Range("A3")
              End With
       .AutoFilter 3, Criteria1:="=*eren alle ond*", Operator:=xlOr, Criteria2:="=*eren van alle ond*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad22").Range("C500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 3, Criteria1:="=*eren : wie*", Operator:=xlOr, Criteria2:="=*eren : mot*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad22").Range("C500").End(xlUp).Offset(0, -2)
              End With
       .AutoFilter 3, Criteria1:="=*meren tak*", Operator:=xlOr, Criteria2:="=*eren : mot*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad22").Range("C500").End(xlUp).Offset(0, -2)
                Sheets("Blad22").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        End With
        
With Sheets("Blad23")
  .Range("A2") = "Kraanbalken"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "*moeilijk bereikbare dele*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad23").Range("A3")
                Sheets("Blad23").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
        
With Sheets("Blad25")
  .Range("A2") = "APVV"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "APVV*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad25").Range("A3")
                Sheets("Blad25").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
 With Sheets("Blad26")
  .Range("A2") = "APVG"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "APVG*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad26").Range("A3")
                Sheets("Blad26").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
 With Sheets("Blad27")
  .Range("A2") = "CPB"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 3, "CPB*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad27").Range("A3")
                Sheets("Blad27").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
              
        End With
 With Sheets("Blad28")
  .Range("A2") = "Curatief"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 6, "CURATIEF"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad28").Range("A3")
                Sheets("Blad28").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
              
        End With
 With Sheets("Blad29")
  .Range("A2") = "In voorbereiding"
  .Range("B2").Resize(, 10) = Split(sq, "|")
  .Range("A2:K2").Interior.ColorIndex = 37
 End With
 End With
With Sheets("Blad1")
 With .Range("A2:K" & .Cells(Rows.Count, 11).End(xlUp).Row)
       .AutoFilter 5, "In voorbereiding"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad29").Range("A3")
                Sheets("Blad29").Columns("E:K").HorizontalAlignment = xlCenter
              End With
              .AutoFilter
        
        End With
For Each cl In .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)

  If cl > 0 Then
       Set C = .Range("AA2:AN250").Find(cl, , xlValues, xlWhole)
       If Not C Is Nothing Then
    firstAddress = C.Address
    Do
    kolom = Mid(C.Address, 3, 1)
    Select Case kolom
    
 Case "A"
    With Sheets("Blad2").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad2")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad2").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "B"
    With Sheets("Blad3").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad3")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad3").Columns("E:K").HorizontalAlignment = xlCenter
    End With
      
 Case "C"
    With Sheets("Blad4").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad4")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad4").Columns("E:K").HorizontalAlignment = xlCenter
    End With
      
 Case "D"
    With Sheets("Blad5").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad5")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad5").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "E"
    With Sheets("Blad6").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad6")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad6").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "L"
    With Sheets("Blad13").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad13")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad13").Columns("E:K").HorizontalAlignment = xlCenter
        Sheets("Blad1").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "M"
    With Sheets("Blad14").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad14")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad14").Columns("E:K").HorizontalAlignment = xlCenter
    End With
    
 Case "N"
    With Sheets("Blad24").Cells(Rows.Count, 3).End(xlUp)
        If cl <> naam Then
          Rij = .Offset(1).Row
         .Offset(1, -2).Resize(, 11).Interior.ColorIndex = 37
         .Offset(1, -2) = cl
         .Offset(1, -1).Resize(, 10) = Split(sq, "|")
        End If
       End With
    With Sheets("Blad24")
     .Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).Resize(, 11) = cl.Offset(, -1).Resize(, 11).Value
     .Range(.Cells(Rij, 1), .Cells(.Cells(Rows.Count, 3).End(xlUp).Row, 11)).Sort .Cells(Rij - 1, 10), , , , , , , xlYes
        Sheets("Blad24").Columns("E:K").HorizontalAlignment = xlCenter
    End With
        End Select
        Set C = .Range("AA2:AN250").FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
     End If
   End If
   If Not cl Is Nothing Then
naam = cl
   End If
  Next cl

For I = .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(I, 3) > 0 Then
       Set C = .Range("AA2:AN250").Find(.Cells(I, 3), , xlValues, xlWhole)
       If Not C Is Nothing Then
     .Cells(I, 3).Offset(, -2).Resize(, 11).Delete shift:=xlUp
   End If
  End If
 Next I
For I = .Range("I2:I" & .Cells(Rows.Count, 10).End(xlUp).Row).Rows.Count To 2 Step -1
If .Cells(I, 10) = "726.EW" Then .Cells(I, 1).Resize(, 11).Delete shift:=xlUp
 Next I
End With
 Dim wrksht As Worksheet
    For Each wrksht In Worksheets
      wrksht.Columns.AutoFit
    Next wrksht
    For I = 1 To 30
        Sheets("Blad" & I).Name = Choose(I, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle", "Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "Controle kraanbalken", "Tangen", "APVV", "APVG", "CPB", "Curatief", "In voorbereiding", "Samenvatting")
    Next
    For x = 1 To 29
[COLOR="#FF0000"]   Sheets(Choose(x, "Rest", "AA-Kranen", "A-Kranen", "B en C - Kranen", "Takels", "LK45xx", "718.MEC", "718.ELE", "718.EXT", "726.KO", _
            "726.EW", "718_VAST", "Dummy", "Klein gereedschap", "A.C. van alle onderdelen", "Herstellingen na controle", "Tonnenkoppelingen", "Stroomafnemers", _
            "Veiligheidsfuncties", "Reinigen motoren", "Isolatiemetingen", "Smeren", "Controle kraanbalken", "Tangen", "APVV", "APVG", "CPB", "Curatief", "In voorbereiding")).Range("A2").AutoFilter[/COLOR]    Next
 With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx")
 Workbooks.Open "H:\Mijn documenten\Lijst_LK's2.xls"
    With .Sheets("Samenvatting")
        Workbooks("Lijst_LK's2.xls").Sheets(1).Range("B2:F35").Copy .Range("B2")
        .Columns("A:F").ColumnWidth = 27.86
    End With
 Workbooks("Lijst_LK's2.xls").Close False
 Windows("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xlsx").Activate
 With Application
    .ScreenUpdating = True
    .SheetsInNewWorkbook = 3
    .Save
'    .Close True
 End With
 End With
End Sub

Kan je hier eens naar kijken aub ?

Nu we Excel 2007 hebben op ons werk (oef !)
Graag zou ik het bestandje willen omzetten naar XLSX, heb dit al gedaan en werkte toen perfect.
Enkel de mapjes met lijst en "H:\Mijn documenten\Danny\*" moet ik nog aanpassen

Groetjes Danny :thumb:
 
Ik heb die bestanden allang niet meer Danny.
Er wordt gezocht naar het blad die als nummer heeft die "x" vertegenwoordigd.
Je kunt het vergelijken met de functie = KIEZEN(X,"danny","harry"), als x de waarde 1 heeft, geeft het Danny retour, als x 2 is, geeft het Harry retour.

1). Loop de code met F8 (debuggen) door, en kijk wat de waarde van "X" is, en kijk of de bladnamen kloppen.
2). Zet de "Next" aan het einde van het rode gedeelte een regel naar onderen.
 
Beste Harry, ;)

Ik zal het morgen uitproberen op mijn werk.

Raar dat het vorige week maandag wel werkte en vandaag niet ???

Indien het niet lukt, stuur ik alles nog eens door met de bijgevoegde bestandjes en links.

Groetjes Danny. :thumb:
 
Beste Harry, ;)

Het is mij niet gelukt de code te doorlopen met de F8 functie, hij blijft steeds in een loop lopen.

Daarom in bijlage de bestandjes die je nodig hebt.

Maak het volgende aan op de H-schijf:
H\Mijn documenten\Danny
H\Mijn documenten

Plaats volgende bestandjes in map H\Mijn documenten\Danny :

718.EL.xls
718.ME.xls
718.EXT.xls
726.KO.xls

Plaats volgende bestandjes in map H\Mijn documenten :

Lijst_LK's.xls
Lijst_LK's2.xls
Lijst_LK's per afdeling.xlsx

In bijlage ook de codes.

Indien geen H-schijf kan je een andere nemen en de code aanpassen.

Indien je tijd mocht hebben kijk er dan op je gemak er eens naar.
Voor de code uit te voeren is het bij mij 1 min 20 sec
Warme bakkertje kan je toch niet kloppen hierin :-)

Groetjes Danny. :thumb:
 

Bijlagen

Laatst bewerkt:
Hallo Danny,

Zo, daar zadel je me op met een hoop gegevens, en gezoek.

Het rode gedeelte in de code waarover je schrijft is in de code gemarkeert als tekst.
Klopt het dat ik het als code moet markeren?
Als tekst opgemaakt loopt de code in één keer door.

Wat wil je bereiken met de Autofilter in dat stukje code?
 
Beste Harry, ;)

Heb een paar bestandjes verwijderd omdat er fouten in zaten.
Vanavond zal ik de nieuwe plaatsen.

Alles moet als code doorlopen worden.
Op de derde regel van de gemarkeerde code loopt hij fout.
Auto.filter wordt toegepast op 29 tabbladen om achteraf te kunnen filteren.

Groetjes Danny. :thumb:
 
Danny, plaats een onderbrekingspunt naast de Next van de lus waar het fout loopt en doorloop dan de code.
de code stopt aan het onderbrekingspunt en door dan telkens op F5 te drukken wordt de lus 1x doorlopen.Als nu de foutmelding verschijnt kan je controleren welke waarde x heeft en zo zien op welk blad het fout loopt.
 
Laatst bewerkt:
Danny,

x = 2, = blad AA-Kranen.
Daar staan geen gegevens in (leeg).
Dus kan er ook geen filter gezet worden.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan