• 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.
Beste HSV ;)

Ik zie niks wijzigen als ik de code laat lopen :confused:

En dit voor de 100ste reactie op deze topic :D

Groetjes Danny :thumb:
 
Danny,

haal .range("A2") voor .autofilter weg, of iets korter.
Code:
With Sheets("Blad1")
 With .Range("A2:J" & .Cells(Rows.Count, 10).End(xlUp).Row)
       .AutoFilter 3, Criteria1:="=*lingen na co*", Operator:=xlOr, Criteria2:="=*sther*"
             With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad13").Range("A3")
              End With
              ' .AutoFilter
          .AutoFilter 3, Criteria1:="=*ling naar co*", Operator:=xlOr, Criteria2:="=*ling na co*"
        With .Offset(1).SpecialCells(xlCellTypeVisible)
                .Copy Sheets("Blad13").Range("C100").End(xlUp).Offset(0, -2)
                Sheets("Blad13").Columns("E:J").HorizontalAlignment = xlCenter
              End With
            .AutoFilter
          End With
 
Beste HSV ;)

Hij plaats nog steeds geen autofilter op rij 2

Voor de rest is alles in orde Harry :thumb:

Groetjes Danny. :thumb:
 
Die heeft de code geplaatst, maar ook weer weggehaald onderaan de code.
Code:
.autofilter
 
Beste HSV ;)

Graag had ik op volgende tabbladen een autofilter willen hebben, tabbladen 9 tem 15

Groetjes Danny. :thumb:
 
Beste HSV ;)

Het is mij ondertussen gelukt om overal een filter bij te plaatsen daar waar nodig was.

Bij deze nogmaals bedankt Harry :thumb:

Het zal waarschijnlijk niet lang duren of het volgende probleem stelt zich :d

Groetjes Danny. :thumb:
 
Beste HSV ;)

Nu zou er nog een samenvatting moeten gebeuren in tabblad "Samenvatting".

Het bereik ("B2F35") met de formules staat op Blad1 van bestand "Lijst_LK's"
De formules bestaan uit Indirect formule en werkt altijd als deze geplakt wordt.
Deze zou moeten gekopieërd worden en in bestand "LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls" geplakt worden.

Had dit geplaatst maar het werkt niet.

Code:
Sub verplaatsen()
 Workbooks.Open "D:\Lijst_LK's.xls"
 Worksheets("Blad1").Range("B2:F35").Copy
 Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls").Paste Destination:=Worksheets("Samenvatting").Range("B2:F35")
 Workbooks("Lijst_LK's.xls").Close True
 ActiveWorkbook.Save
 ActiveWorkbook.Close True
End Sub

Groetjes Danny. :thumb:
 
Onder 'Loop' in het bestand heb je soortgelijke code Danny.
Code:
With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls")
     With .Sheets(1)
        On Error Resume Next
            .Range("J2:J13000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
            .Range("B3:J13000").Sort Key1:=Range("C2"), Order1:=xlAscending
              Workbooks.Open "D:\Lijst_LK's.xls"
                Workbooks("Lijst_LK's.xls").Sheets("Blad1").Range("AA1").CurrentRegion.Copy .Range("AA1")

Probeer daar eens iets van te maken.
 
Beste HSV ;)

Geprobeerd met deze, maar ook niks .

Code:
Sub verplaatsen()
    With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls")
    Workbooks.Open "D:\Lijst_LK's.xls"
    Workbooks("Lijst_LK's.xls").Sheets("Blad1").Range("B2:F35").Copy.Sheets("test").Range ("B2:F35")
    End With
End Sub

CurrentRegion is hier niet van toepassing, geen aangrenzende cellen.

Groetjes Danny. :thumb:
 
Denk aan een spatie na .copy.

Voor ik het morgen vergeet, alvast van harte gefeliciteerd met je verjaardag Danny. :thumb:
 
Laatst bewerkt:
Beste HSV ;)

Wat ik ook probeer of doe, onderstaande nieuwe code werkt nog steeds niet :confused:

Code:
 Workbooks.Open "D:\Lijst_LK's2.xls"
    With Workbooks("Lijst_LK's2.xls")
     With .Sheets(1).Range("B2:F35").Copy
      With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls")
       With .Sheets("Samenvatting").Range("B2:F35").Paste
            Columns("A:F").ColumnWidth = 27.86
    End With
     End With
      End With
       End With
 Workbooks("Lijst_LK's2.xls").Close True
Dit stukje code komt dan helemaal onderaan te staan voor Application.ScreenUpdating = True


Bij paste krijg ik de foutmlding.

Ik word ook al een dagje ouder hoor :D :p

Groetjes Danny. :thumb:
 
Beste HSV ;)
Ik word ook al een dagje ouder hoor :D :p
Groetjes Danny. :thumb:

:D:D Oké ik heb het gezien. :D:D

Gaat wel weer over, denk ik, ik ben ook niet echt veel ouder hoor (1964).

Code:
Sub verplaatsen()
    With Workbooks("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls")
    Workbooks.Open "D:\Lijst_LK's.xls"
    Workbooks("Lijst_LK's.xls").Sheets("Blad1").Range("B2:F35").Copy .Sheets("test").Range ("B2")
    End With
End Sub

De spatie staat achter .Copy
 
Beste HSV ;)

Deze had ik al geprobeerd met de spatie achter .Copy . maar zonder resultaat.

Heb deze middag zitten zoeken op het net en heb deze dan in elkaar gestoken:

Code:
    Workbooks.Open "D:\Lijst_LK's2.xls"
    With Workbooks("Lijst_LK's2.xls")
    With .Sheets(1).Range("B2:F35").Copy
    Windows("LK-Kranen 27-03-2012.xls").Activate
    Sheets("Samenvatting").Select
    Range("B2").Select
    ActiveSheet.Paste
    Columns("A:F").ColumnWidth = 27.86
    Windows("Lijst_LK's2.xls").Activate
    Application.CutCopyMode = False
    Workbooks("Lijst_LK's2.xls").Close True
    Windows("LK-Kranen 27-03-2012.xls").Activate
    End With
    End With

Maar dit is niet de manier waarop jij werkt.
bereik B2:F35 blijft geselecteerd en Workbooks("Lijst_LK's2.xls") sluit niet van zichzelf, vraagt of hij dit mag sluiten.

Groetjes Danny. :thumb:
 
Hallo Danny,

Ik moest ook naar een verjaardag, vandaar de wat late reactie.

Even een vraag.

Je maakt een nieuwe werkboek aan die we gaan saven als 'LK-Kranen & format.....', maar daarin bestaat geen blad genaamd 'Samenvatting'.
Dus zullen we ergens een blad moeten hernoemen.
Of heb jij in een stukje code dit al ergens ingevoegd?

De code die ik nu heb staat verder voor je klaar behalve dat ene ding nog.
 
Beste HSV ;)

De code is nu al uitgebreid naar 28 tabbladen.
Ik ben steeds in de weer geweest :D

Zie in bijlage de volledige code.

Deze werkt nu perfect, maar het laatste stukje is niet geschreven zoals jij met VBA werkt. :D
Misschien bestaat er een kortere code om alle tabbladen te voorzien van autofilter.
Ik heb ze allemaal één voor één beschreven.

Groetjes Danny. :thumb:
 

Bijlagen

Beste HSV ;)

De volgende bestandjes vergeten mee te geven:

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

Deze moeten alle vier in een mapje gestoken worden met naam Danny op de D-schijf

Lijst_LK's en Lijst_LK's2 moeten op de D-schijf geplaatst worden.

Veel succes.

Groetjes Danny. :thumb:
 

Bijlagen

Laatst bewerkt:
Probeer dit laatste stukje eens Danny.
Ongetest.
Mijn Pc doet er veel te lang over om die vier bestandjes ook nog te verwerken.
Dus laat ik het zo maar een beetje aanmodderen.
Alhoewel ik denk dat de grens bij mij wel zo’n beetje bereikt is.

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
 
 [COLOR="#FF0000"]Dim wrksht As Worksheet
    For Each wrksht In Worksheets
      With wrksht
        .Columns.AutoFit
        .Range("A2").AutoFilter
      End With
    Next wrksht[/COLOR]
 Sheets("Blad1").Name = "Rest"
 Sheets("Blad2").Name = "AA-Kranen"
 Sheets("Blad3").Name = "A-Kranen"
 Sheets("Blad4").Name = "B en C - Kranen"
 Sheets("Blad5").Name = "Takels"
 Sheets("Blad6").Name = "LK45xx"
 Sheets("Blad7").Name = "718.MEC"
 Sheets("Blad8").Name = "718.ELE"
 Sheets("Blad9").Name = "718.EXT"
 Sheets("Blad10").Name = "726.KO"
 Sheets("Blad11").Name = "726.EW"
 Sheets("Blad12").Name = "718_VAST"
 Sheets("Blad13").Name = "Dummy"
 Sheets("Blad14").Name = "Klein gereedschap"
 Sheets("Blad15").Name = "A.C. van alle onderdelen"
 Sheets("Blad16").Name = "Herstellingen na controle"
 Sheets("Blad17").Name = "Tonnenkoppelingen"
 Sheets("Blad18").Name = "Stroomafnemers"
 Sheets("Blad19").Name = "Veiligheidsfuncties"
 Sheets("Blad20").Name = "Reinigen motoren"
 Sheets("Blad21").Name = "Isolatiemetingen"
 Sheets("Blad22").Name = "Smeren"
 Sheets("Blad23").Name = "APVV"
 Sheets("Blad24").Name = "APVG"
 Sheets("Blad25").Name = "CPB"
 Sheets("Blad26").Name = "Curatief"
 Sheets("Blad27").Name = "In voorbereiding"
 Sheets("Blad28").Name = "Samenvatting"
            [COLOR="#008000"] 'Sheets("Rest").Range("A2").AutoFilter
            ' Sheets("AA-Kranen").Range("A2").AutoFilter
            ' Sheets("A-Kranen").Range("A2").AutoFilter
            ' Sheets("B en C - Kranen").Range("A2").AutoFilter
            ' Sheets("Takels").Range("A2").AutoFilter
            ' Sheets("LK45xx").Range("A2").AutoFilter
            ' Sheets("718.MEC").Range("A2").AutoFilter
            ' Sheets("718.ELE").Range("A2").AutoFilter
            ' Sheets("718.EXT").Range("A2").AutoFilter
            ' Sheets("726.KO").Range("A2").AutoFilter
            ' Sheets("726.EW").Range("A2").AutoFilter
            ' Sheets("718_VAST").Range("A2").AutoFilter
            ' Sheets("Dummy").Range("A2").AutoFilter
            ' Sheets("Klein gereedschap").Range("A2").AutoFilter
            ' Sheets("A.C. van alle onderdelen").Range("A2").AutoFilter
            ' Sheets("Herstellingen na controle").Range("A2").AutoFilter
            ' Sheets("Tonnenkoppelingen").Range("A2").AutoFilter
            ' Sheets("Stroomafnemers").Range("A2").AutoFilter
            ' Sheets("Veiligheidsfuncties").Range("A2").AutoFilter
            ' Sheets("Reinigen motoren").Range("A2").AutoFilter
            ' Sheets("Isolatiemetingen").Range("A2").AutoFilter
            ' Sheets("Smeren").Range("A2").AutoFilter
            ' Sheets("APVV").Range("A2").AutoFilter
            ' Sheets("CPB").Range("A2").AutoFilter
            ' Sheets("APVG").Range("A2").AutoFilter
            ' Sheets("Curatief").Range("A2").AutoFilter
            ' Sheets("In voorbereiding").Range("A2").AutoFilter[/COLOR]             
[COLOR="#FF0000"]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[/COLOR] 'kan volgens mij op false, er wordt niets gewijzigd
   Windows("LK-Kranen " & Format(Date, "d-mm-yyyy") & ".xls").Activate
    
    Application.ScreenUpdating = True
    Application.SheetsInNewWorkbook = 3
    ActiveWorkbook.Save
    ActiveWorkbook.Close True
[COLOR="#FF0000"] End With[/COLOR]
End Sub
 
Beste HSV ;)

Foutmelding op volgende regels:

.Range("A2").AutoFilter

With .Sheets("Samenvatting")

Daarna code stopgezet.

Bestandje is aangemaakt maar geen gegevens bij tabblad samenvatting.
De rest is allemaal in orde.

Groetjes Danny. :thumb:
 
Laatst bewerkt:
Nieuwe poging Danny.
Op de oude voet van jou verder.
Ik zie door de bomen de 'With' en de 'End With' niet meer.

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

 Sheets("Blad1").Name = "Rest"
 Sheets("Blad2").Name = "AA-Kranen"
 Sheets("Blad3").Name = "A-Kranen"
 Sheets("Blad4").Name = "B en C - Kranen"
 Sheets("Blad5").Name = "Takels"
 Sheets("Blad6").Name = "LK45xx"
 Sheets("Blad7").Name = "718.MEC"
 Sheets("Blad8").Name = "718.ELE"
 Sheets("Blad9").Name = "718.EXT"
 Sheets("Blad10").Name = "726.KO"
 Sheets("Blad11").Name = "726.EW"
 Sheets("Blad12").Name = "718_VAST"
 Sheets("Blad13").Name = "Dummy"
 Sheets("Blad14").Name = "Klein gereedschap"
 Sheets("Blad15").Name = "A.C. van alle onderdelen"
 Sheets("Blad16").Name = "Herstellingen na controle"
 Sheets("Blad17").Name = "Tonnenkoppelingen"
 Sheets("Blad18").Name = "Stroomafnemers"
 Sheets("Blad19").Name = "Veiligheidsfuncties"
 Sheets("Blad20").Name = "Reinigen motoren"
 Sheets("Blad21").Name = "Isolatiemetingen"
 Sheets("Blad22").Name = "Smeren"
 Sheets("Blad23").Name = "APVV"
 Sheets("Blad24").Name = "APVG"
 Sheets("Blad25").Name = "CPB"
 Sheets("Blad26").Name = "Curatief"
 Sheets("Blad27").Name = "In voorbereiding"
 Sheets("Blad28").Name = "Samenvatting"
        Sheets("Rest").Range("A2").AutoFilter
        Sheets("AA-Kranen").Range("A2").AutoFilter
        Sheets("A-Kranen").Range("A2").AutoFilter
        Sheets("B en C - Kranen").Range("A2").AutoFilter
        Sheets("Takels").Range("A2").AutoFilter
        Sheets("LK45xx").Range("A2").AutoFilter
        Sheets("718.MEC").Range("A2").AutoFilter
        Sheets("718.ELE").Range("A2").AutoFilter
        Sheets("718.EXT").Range("A2").AutoFilter
        Sheets("726.KO").Range("A2").AutoFilter
        Sheets("726.EW").Range("A2").AutoFilter
        Sheets("718_VAST").Range("A2").AutoFilter
        Sheets("Dummy").Range("A2").AutoFilter
        Sheets("Klein gereedschap").Range("A2").AutoFilter
        Sheets("A.C. van alle onderdelen").Range("A2").AutoFilter
        Sheets("Herstellingen na controle").Range("A2").AutoFilter
        Sheets("Tonnenkoppelingen").Range("A2").AutoFilter
        Sheets("Stroomafnemers").Range("A2").AutoFilter
        Sheets("Veiligheidsfuncties").Range("A2").AutoFilter
        Sheets("Reinigen motoren").Range("A2").AutoFilter
        Sheets("Isolatiemetingen").Range("A2").AutoFilter
        Sheets("Smeren").Range("A2").AutoFilter
        Sheets("APVV").Range("A2").AutoFilter
        Sheets("CPB").Range("A2").AutoFilter
        Sheets("APVG").Range("A2").AutoFilter
        Sheets("Curatief").Range("A2").AutoFilter
        Sheets("In voorbereiding").Range("A2").AutoFilter
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
    
    Application.ScreenUpdating = True
    Application.SheetsInNewWorkbook = 3
    ActiveWorkbook.Save
    ActiveWorkbook.Close True
 End With
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan