Tabblad naam op voorwaarde kopieren middels loop

[debastaard]

Beste Helpmij-ers,

Ik heb de volgende vraag. Ik heb een excel file met een heel aantal sheets. Als er in die sheets in kolom AA en AC een "x" wordt ingevuld dan wordt er een afwijkingsnummer gegenereerd. Dit werkt allemaal. Omdat ik het overzicht kwijt raak van waar de afwijkingsnummers staan wil ik graag op een apart blad de namen van de sheets waar dus een afwijkingsnummer staat.

Ik heb de volgende code gefabriceerd:

Private Sub Worksheet_Activate()
  Dim f
  Dim i As Integer
  Dim invoegrange As range
  
  Application.ScreenUpdating = False
  
  For Each f In ActiveWorkbook.Sheets
  With f
      For i = 1 To ActiveWorkbook.Sheets.Count
      Set invoegrange = Blad7.Range("A65536").End(xlUp)(2, 1)
      If .Cells(i, 27).Value = "x" And .Cells(i, 29).Value = "x" Then invoegrange = Sheets(i).Name
      Next i
    End With
  Next
  
End Sub

Nu krijg ik wel namen van sheets, maar dit zijn de verkeerde. Wat doe ik verkeerd?

 

[Wigi]

Waarom maak je 2 keer een lus?

 

[debastaard]

Hoi Wigi,

Weet ik niet, heb ook geprobeerd deze weg te halen maar dan gebeurt er niets. Bij het genereren van het afwijkingsnummer gebruik ik dit ook, in een andere vorm, en daar werkt het perfect. Was dus in de veronderstelling dat ik het niet verkeerd deed.

 

[Wigi]

Test dit eens uit:

Private Sub Worksheet_Activate()
  
    Dim ws As Worksheet
    Dim l As Long
    Dim invoegrange As Range
  
    Application.ScreenUpdating = False
  
    For Each ws In ActiveWorkbook.Sheets
        With ws
            For l = 1 To .UsedRange.Rows.Count
                Set invoegrange = Blad7.Range("A" & Rows.Count).End(xlUp).Offset(1)
                If .Cells(i, 27).Value = "x" And .Cells(i, 29).Value = "x" Then invoegrange.Value = .Name
            Next l
        End With
    Next ws
    
    Application.ScreenUpdating = True
  
End Sub

Wigi

 

[debastaard]

Werkt perfect! Bedankt!

 

[Wigi]

Graag gedaan.

Let wel dat deze code ELKE keer wordt uitgevoerd als je dat tabblad selecteert. Dat lijkt me misschien wel wat veel soms, maar dat is jouw keuze.

Groeten

Wigi