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

Code voor meerdere tabbladen

Status
Niet open voor verdere reacties.
Beste,

Dit geeft het zelfde resultaat dan deze code die ik al had
Door steeds te veranderen geraak ik niet verder
Ben wel tevreden dat iedereen zijn steentje wil bijdragen maar hou het op de bestaande code a.u.b.

Deze code en die eronder doen precies hetzelfde.

Code:
  With Sheets("Output").Cells(1).CurrentRegion
    For j = 1 To UBound(sn)
     .AutoFilter 15, sn(j, 1) & "*"
      .Copy Sheets("Orders na opmaakdatum").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next
  End With

Code:
    For i = 1 To Sheets("Systeem").Range("AQ2").Value

    zoekwaarde = Sheets("Systeem").Range("AO" & i + 1) & "*"

        With Sheets("Output").Activate

            ActiveSheet.Cells(1).CurrentRegion.AutoFilter Field:=15, Criteria1:=zoekwaarde, Operator:=xlAnd

            Range("A1").CurrentRegion.Copy Destination:=ThisWorkbook.Sheets("Orders na opmaakdatum").Range("A500").End(xlUp).Offset(2, 0)

        End With

    Next i

De bedoeling is nu dat ik het hele bereik niet wil maar enkel bepaalde kolommen met gegevens weg te schrijven die zichtbaar zijn na het filteren

Kolom 3 moet naar kolom 1 in tabblad "Orders na opmaakdatum"
Kolom 4 moet naar kolom 2 in tabblad "Orders na opmaakdatum"
Kolom 6 moet naar kolom 3 in tabblad "Orders na opmaakdatum"
Kolom 11 moet naar kolom 4 in tabblad "Orders na opmaakdatum"
Kolom 9 moet naar kolom 9 in tabblad "Orders na opmaakdatum"
Kolom 8 moet naar kolom 10 in tabblad "Orders na opmaakdatum"
Kolom 13 moet naar kolom 12 in tabblad "Orders na opmaakdatum"
Kolom 14 moet naar kolom 13 in tabblad "Orders na opmaakdatum"
Kolom 2 moet naar kolom 14 in tabblad "Orders na opmaakdatum"

In bijlage nog eens het bestandje.
Sommige blokken zijn niet actief geplaatst in de code zodat de "output" niet verwijderd wordt
 

Bijlagen

  • Meerdere tabbladen.xlsm
    902,8 KB · Weergaven: 30
Laatst bewerkt:
Beste,

Na wat zoekwerk kan ik met deze vooruit:

Code:
    For i = 1 To Sheets("Systeem").Range("AQ2").Value

    zoekwaarde = Sheets("Systeem").Range("AO" & i + 1) & "*"

        With Sheets("Output").Activate

            ActiveSheet.Cells(1).CurrentRegion.AutoFilter Field:=15, Criteria1:=zoekwaarde, Operator:=xlAnd
            Range("C2:D7000").SpecialCells(xlCellTypeVisible).Copy Sheets("Orders na opmaakdatum").Range("A500").End(xlUp).Offset(1, 0)
            Range("F2:F7000").SpecialCells(xlCellTypeVisible).Copy Sheets("Orders na opmaakdatum").Range("C500").End(xlUp).Offset(1, 0)
            Range("K2:K7000").SpecialCells(xlCellTypeVisible).Copy Sheets("Orders na opmaakdatum").Range("D500").End(xlUp).Offset(1, 0)
            Range("I2:I7000").SpecialCells(xlCellTypeVisible).Copy Sheets("Orders na opmaakdatum").Range("I500").End(xlUp).Offset(1, 0)
            Range("H2:H7000").SpecialCells(xlCellTypeVisible).Copy Sheets("Orders na opmaakdatum").Range("J500").End(xlUp).Offset(1, 0)
            Range("M2:N7000").SpecialCells(xlCellTypeVisible).Copy Sheets("Orders na opmaakdatum").Range("L500").End(xlUp).Offset(1, 0)
            Range("B2:B7000").SpecialCells(xlCellTypeVisible).Copy Sheets("Orders na opmaakdatum").Range("N500").End(xlUp).Offset(1, 0)
        
            If i < Sheets("Systeem").Range("AQ2").Value Then
                Sheets("Orders na opmaakdatum").Range("A1:R1").Copy Destination:=ThisWorkbook.Sheets("Orders na opmaakdatum").Range("C500").End(xlUp).Offset(2, -2)
            End If

        End With
    Next i
 
Beste,

Hoe kan ik ervoor zorgen dat hij steeds start vanaf "Blad1" en dan 10 tabbladen erbij
Blad1 kan als eerste staan maar ook als tweede tabblad staan
Enkel de tabbladen "Blad1" tem "Blad11" (Project namen)

Code:
    For I = 1 To 11
        For Each x In Sheets(I).Range("A30:A500")
            If Left(x, 2) = "LK" Or Left(x, 1) = "S" Then
                x.Copy Destination:=Worksheets("Systeem").Range("AN500").End(xlUp).Offset(1, 0)
            End If
        Next x
    Next I
 
Laatst bewerkt:
Denk eraan dat je met Sheets(I) verwijst naar het indexnummer van een blad en niet naar de naam van het blad.
Sheets(1) kan dus een heel ander blad zijn dan Blad1.
 
Heten de tabjes ook Blad1,Blad2,etc? Vast niet.

Code:
For each sh in sheets(array("Blad1","Blad2", etc))
 
Beste,

Zo dan:

Code:
    For Each sh In Sheets(Array("Ma Vm + Dag", "Ma Nm", "Ma Nm", "Di Nm", "Wo Vm + Dag", "Wo Nm", "Do Vm + Dag", "Do Nm", "Vr Vm + Dag", "Vr Nm", "Za Vm"))
        For Each x In sh.Range("A30:A500")
            If Left(x, 2) = "LK" Or Left(x, 1) = "S" Then
                x.Copy Destination:=Worksheets("Systeem").Range("AN500").End(xlUp).Offset(1, 0)
            End If
        Next x
    Next sh
 
Breng structuur aan in de code en de werkbladen. Gebruik geen code en formules door elkaar als het niet nodig is. Gebruik geen samengevoegde cellen. Al mijn commentaar behalve van wat structuur in de code, niet toegepast. Als jullie machinisten net zo werken als jij de code opzet dan worden het dure projecten.

Code:
Sub VenA()
  For Each sh In Sheets(Array("Ma Vm + Dag", "Ma Nm", "Di Vm + Dag", "Di Nm"))
    For Each cl In sh.Range("A20:A38").SpecialCells(2)
      If Left(cl, 2) = "LK" Or Left(cl, 1) = "S" Then c00 = c00 & "|" & cl
    Next cl
  Next sh
  
  ar = Split(Mid(c00, 2), "|")
  With Sheets("Systeem")
    .Columns(40).SpecialCells(2).Offset(1).ClearContents
    .Cells(2, 40).Resize(UBound(ar) + 1) = Application.Transpose(ar)
    ar = .Cells(2, 41).Resize(UBound(ar) + 1)
  End With
  
  Sheets("Orders na opmaakdatum").Range("A2:R1000").Clear
  
  With Sheets("Output").Cells(1).CurrentRegion
    .AutoFilter 5, ">=" & CLng(Sheets("Ma Vm + Dag").Range("A2"))
    For j = 1 To UBound(ar)
      .AutoFilter 15, ar(j, 1) & "*"
      .Offset(1).Copy Sheets("Orders na opmaakdatum").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next j
  End With
End Sub

Bovenstaande kan ook eenvoudiger maar ik heb geen idee wat je eigenlijk wil bereiken.
 
Beste VenA,

De code die je hier schrijft heb ik al gekregen van snb in Post #16 en zie opmerking in Post #21

In bijlage heb ik de originele versie opgeladen met daarin 2 codes in module met naam "Orders_N2N1"
Mijn code starten via icoontje kalender in het Lint, uw code starten met VenA

Zie het verschil met jouw en mijn code in tabblad "Orders na opmaakdatum" en "Orders na opmaakdatum VenA"
Niet naar de opmaak kijken wat zover was jij nog niet.
Mijn code schrijft de gegevens naar de juiste kolommen terwijl jouw code de ganse regel wegschrijft.

Als er nog 1 ding is dat mag aangepast worden dan is het de dubbelen in Tabblad "Systeem" Range AN2:AN100
Indien de code korter kan is dit mooi meegenomen en kan ik hier nog wat van opsteken.

De bedoeling van deze opzet is dat de planning 14 dagen voor uitvoerdatum wordt opgemaakt en dat er orders zijn die in tussentijds zijn opgemaakt niet in de planning staan.
Via deze weg kunnen wij zien of deze orders belangrijk zijn om alsnog in de planning te verwerken.

Indien er nog vragen zijn dan hoor ik het wel, met dank :thumb:
 

Bijlagen

  • WK 18 - Ma 30-4 tem Za 5-5.xlsm
    999,5 KB · Weergaven: 42
Laatst bewerkt:
Ik heb je alleen een idee gegeven hoe je de code beter/logischer kan opzetten. Voor complete projecten kan je beter een ontwikkelaar inhuren. Kost een paar centen maar dan heb je het resultaat ook binnen een afgesproken termijn. Scheelt jouw veel vragen stellen, er tijd in te besteden, en is per saldo voordeliger.;) Het doel van Helpmij.nl is in mijn optiek het verder helpen met vragen en niet om complete projecten te ontwikkelen. Dus succes met de zoektocht.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan