waardes filteren en copieeren naar een andere pagina

[mrnico]

Hallo ik ben opzoek naar het volgende

heb een bestand waar ik een aantal motoren controleer hierbij kunnen ze 3 statussen hebben ( Goed / Aandacht / Onderhoud )
deze motoren worden per machine op een blad verzameld nu wil ik graag 1 pagina waar ik alle motoren die onderhoud of aandacht nodig hebben tegelijk kan zien
zoals ik in het voorbeeld heb gedaan alleen dan graag automatich


als ik op de knop klik wil ik graag dat de lijst ingevult word met de rijen die (status aandacht of onderhoud hebben)
zo als ik nu ingevult heb maar dan automatich heb al verschillende dingen bekenken maar lukt niet


Bekijk bijlage vraag.xlsm

 

[Jack Nouws]

Hoi

Misschien is een filter een optie?

 

[gast0660]

Zoiets?

 

[mrnico]

Zoiets?

de code werkt inderdaad goed alleen nu net te goed
hij zoekt nu het hele bestand door dit moeten alleen een paar pagina's worden heb gevonden waar hij zegt dat hij het hele bestand door zoekt
maar snap nog niet hoe dit anders moet alles wat ik probeer werkt niet

Option Explicit
Sub dotchie()
Dim i As Long, j As Long, lastRow As Long
Dim sh As Worksheet
With sheets("STORINGS OVERZICHT")
.Cells.Clear
.Range("B1") = "Motor"
.Range("C1") = "status"
.Range("D1") = "uren te gaan"
.Range("E1") = "machine"
.Range("B1:E1").Font.Bold = True
End With
j = 2
For Each sh In ActiveWorkbook.sheets               <  denk dat het nier moet worden gewijzigd   moet ( MBZH & MBZH2 ) worden
    If sh.Name <> "STORINGS OVERZICHT" Then
        lastRow = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row
        For i = 2 To lastRow
            If sh.Range("C" & i) = "Onderhoud nodig!" Or sh.Range("C" & i) = "Aandacht !!" Then
                sh.Range("B" & i & ":D" & i).Copy Destination:=Worksheets("STORINGS OVERZICHT").Range("B" & j)
                sheets("STORINGS OVERZICHT").Range("E" & j) = sh.Name
                j = j + 1
            End If
        Next i
    End If
Next sh
sheets("STORINGS OVERZICHT").Columns("B:E").AutoFit
End Sub

 

[VenA]

Gewoon de data vastleggen in één tabel en een draaitabel gebruiken. Dan heb je al die tabjes en code niet nodig.:d

 

[mrnico]

Gewoon de data vastleggen in één tabel en een draaitabel gebruiken. Dan heb je al die tabjes en code niet nodig.:d

Dit is te simpel gedacht bestand bevat veel meer bewerkingen

mijn voorbeeld is maar een deel van het bestand

 

[gast0660]

Hoi,

alleen een paar pagina's

verander

For Each sh In ActiveWorkbook.sheets

in zoiets

For Each sh In ActiveWorkbook.sheets(Array("MACH1", "MACH2", "MACH3"))

 

[HSV]

Als het om het werkboek gaat waar de code in staat, maak dan gebruik van 'thisworkbook.sheets' ipv 'activeworkbook,sheets.

Zonder kan natuurlijk ook als het om thisworkbook gaat.

For Each sh In sheets(Array("MACH1", "MACH2", "MACH3"))

 

[mrnico]

bedankt het is gelukt

alleen krijg ik nu nog hele rare waardes omdat ik al mijn teksten van andere pagina's af haal
omdat ze dan makkelijk in 1 keer te wijzigen zijn en nu kopieert hij de formules ook ik moet de exacte tekst hebben

 

[mrnico]

Hoi,

verander

For Each sh In ActiveWorkbook.sheets

in zoiets

For Each sh In ActiveWorkbook.sheets(Array("MACH1", "MACH2", "MACH3"))

dat werkt

alleen krijg ik nu nog hele rare waardes omdat ik al mijn teksten van andere pagina's af haal
omdat ze dan makkelijk in 1 keer te wijzigen zijn en nu kopieert hij de formules ook ik moet de exacte tekst hebben

 

[VenA]

Het onnodig quoten mag je wel achterwege laten. Dat het bestand veel meer bewerkingen bevat is nergens terug te vinden. In het geplaatste bestand staan geen formules alleen verwijzingen naar een extern bestand.

Dit mag je even nader uitleggen:

alleen krijg ik nu nog hele rare waardes omdat ik al mijn teksten van andere pagina's af haal

Obv het bestandje in #1 lijkt mij dit voldoende:

Sub VenA()
  Application.ScreenUpdating = False
  Sheet2.Cells(6, 2).CurrentRegion.Offset(1).EntireRow.Delete
  For Each sh In Sheets(Array("MACH1", "MACH2"))
    With sh.Cells(7, 3).CurrentRegion
      .AutoFilter 2, Array("Aandacht !!", "Onderhoud nodig!"), xlFilterValues
      .Offset(1).Copy Sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1)
    End With
    sh.AutoFilterMode = False
  Next sh
End Sub

 

[mrnico]

Bedankt het probleem is opgelost

 

[HSV]

Even een kleine vraag/opmerking.

Hoe kan het dat er in het bestand van #1 'Blad1' staat in het Vba-Project, en in het bestand uit #11 'Sheet1' ?
Versieverschil Eng/Ned natuurlijk, maar dan heeft het geen enkele zin om het zo in de code aan te geven, en kan je beter gebruiken wat er tussen de haakjes staat.

Ps. '.autofilter' tussen de "with" constructie verwijderd ook de filters.