VBA inhoud alle werkbladen controleren

[Djang]

Hoi ,

ik heb een materiaallijst die bestaat uit 14bladen naast elk onderdeel is er een lege kolom(G,I L,N) waar een X in komt als ze deze aanklikken .
als ze al het materiaal aangeduid hebben dat ze moeten hebben is er een knop waar ze op moeten drukken
en dan zou al het materiaal waar een X naast staat gekopieerd moeten worden naar een ander werkboek op blad 1 vanaf cel A26 ( dus telkens copy naar eerste lege cel na A26).

greetings Jan

 

[edmoor]

Wat je wilt lijkt me geen enkel probleem, maar met een goed voorbeeld is dat veel makkelijker aan te geven.

 

[Djang]

Bekijk bijlage Map4.xlsm

dit is een test werkboek en voorlopig kopier ik de gegevens naar blad 2
maar het is de bedoeling dat ik de inhoud van kolom A en F kopier als er in kolom G een X staat en kolom A en H als er in I een X staat naar een ander werkboek Blad1 vanaf cel A26

hopelijk is het nu iets duidelijker

greetings jan

 

[VenA]

Maak gebruik van de tabelfuncties en het filter. Gebruik kolomkoppen en begin in cel A1. Of plaats een voorbeeldje die aansluit bij de vraag.

 

[edmoor]

Uitgaande van het voorbeeld middels het document dat je bijsloot zou ik er zoiets van maken:

Private Sub zoeken()
    Dim i As Integer
    Dim j As Integer
    Dim x As Integer

    j = 26
    For i = 4 To Sheets("Blad1").UsedRange.Rows.Count
        With Sheets("Blad1").UsedRange
            If .Cells(i, 7) = "X" Then x = 6
            If .Cells(i, 9) = "X" Then x = 8
            If x > 0 Then
                Sheets("Blad2").Cells(j, 1) = .Cells(i, 1)
                Sheets("Blad2").Cells(j, 2) = .Cells(i, x)
                j = j + 1
                x = 0
            End If
        End With
    Next
    Sheets("Blad2").UsedRange.Columns.AutoFit
End Sub

 

[Djang]

Hoi edmoor ik had ook al wat gevonden maar de uwe is korter Thanks
toch nog een vraagje : uw werkt nu voor Blad1 hoe pas ik het aan dat hij al de 14 bladen doorzoekt ?

greetings Jan

dit was de code die ik al had

Private Sub zoeken()

Set wb = Workbooks("Map4.xlsm")
Set ws1 = Worksheets(Array("Blad1", "Blad2"))
Set ws2 = Worksheets("Blad3")

aantal = ActiveWorkbook.Worksheets.Count

Sheets("Blad1").Activate
Range("A1").Select

For i = 1 To aantal
bladnr = "Blad" + Format(i)
Sheets(bladnr).Activate
Range("A1").Select


Dim location As Range
For Each cell In Range("G3:G50")
If cell.Value = "X" Then
Set location = ws2.Range("A200").End(xlUp).Offset(1, 0)
location.Value = cell.Value
location.Offset(0, 1).Value = cell.Offset(0, -6).Value
location.Offset(0, 3).Value = cell.Offset(0, -1).Value
End If
Next cell
For Each cell In Range("I3:I50")
If cell.Value = "X" Then
Set location = ws2.Range("A200").End(xlUp).Offset(1, 0)
location.Value = cell.Value
location.Offset(0, 1).Value = cell.Offset(0, -8).Value
location.Offset(0, 3).Value = cell.Offset(0, -1).Value
End If

Next cell
Next
End Sub

 

[edmoor]

Dan komt er nog een loopje omheen: For w = 1 to Worksheets.Count en Sheets("Blad1").UsedRange.Rows.Count wijzig je dan in Sheets(w).UsedRange.Rows.Count.

Waar nu Blad2 wordt gebruikt moet je dan uiteraard een nieuw werkboek gebruiken zoals je in je intitiële vraag al zei.

 

[Djang]

Hoi edmoor

loopt vast op For w = 1 to Workseets.Count

fout 424 , object vereist

greetings jan

 

[edmoor]

Workseets moet Worksheets zijn. Had ik aangepast in m'n vorige reactie. Daar stonden 2 foutjes in.

 

[Djang]

Thanks , ik had het niet gezien (sorry)

heb With Sheets("Blad1").UsedRange ook nog aangepast in With Sheets(w).UsedRange

en nu werkt het hele maal

Greetings Jan

 

[edmoor]

Ok dan. Well done :thumb:

 

[Djang]

thanks edmoor

 

[Djang]

Hoi edmoor

hoe kan ik het gemakkelijkste de ingevulde X-en verwijderen op het einde als ik de materiaallijst sluit ?

Greetings Jan

 

[edmoor]

Ik weet niet op welk moment je dat precies bedoeld, maar het kan in dezelfde functie. Kijk naar dit stukje:

        With Sheets("Blad1").UsedRange
            If .Cells(i, 7) = "X" Then x = 6
            If .Cells(i, 9) = "X" Then x = 8
            If x > 0 Then
                Sheets("Blad2").Cells(j, 1) = .Cells(i, 1)
                Sheets("Blad2").Cells(j, 2) = .Cells(i, x)

                 'X verwijderen
		.Cells(i, 7) = ""
		.Cells(i, 9) = ""

                j = j + 1
                x = 0
            End If
        End With

 

[Djang]

thanks , ik schreef het onder wb.Sheets("HoofdBlad").UsedRange.Columns.AutoFit en dat werkt niet

greetings jan

 

[edmoor]

Uiteraard niet. Want daar heeft de variabele i niet meer de juiste waarde.