VBA Alleen zichtbare rijen overnemen

[wiegerklijnstra]

Beste mensen,
Ik heb een klein scripje wat in stand moet blijven aangezien het her en der wordt gebruikt. Er dient voor een specifiek blad iets aangepast te worden zodat alleen de zichtbare (gefilterde rijen) moet worden overgenomen naar een ander blad. Ik heb al iets met
SpecialCells(xlCellTypeVisible) geprobeerd maar krijg dat er niet goed in. Wie krijgt dit er wel goed in? Alvast bedankt.

Sub maak()
        
    Dim rij As Long, n%
    n = 20: rij = 11
    With Sheets("Bestellingen")
        For rij = 10 To [A65535].End(xlUp).Row
            If Cells(rij, 1).Value <> 0 Then
                If n > 2012 Then
                    MsgBox (" Aantal vrije regels in de bestellijst is te klein! ")
                    Exit Sub
                End If
                .Cells(n, 2).Value = Cells(rij, 1).Value    ' Lev. code
                .Cells(n, 3).Value = Cells(rij, 2).Value    ' ArtId
                .Cells(n, 4).Value = Cells(rij, 3).Value    ' Aantal
                .Cells(n, 5).Value = Cells(rij, 4).Value    ' Merk
                .Cells(n, 6).Value = Cells(rij, 5).Value    ' Type
                .Cells(n, 7).Value = Cells(rij, 6).Value    ' Tekst
                .Cells(n, 8).Value = Cells(rij, 7).Value    ' Artikelcode
                .Cells(n, 9).Value = Cells(rij, 8).Value    ' Prijs
                .Cells(n, 10).Value = Cells(rij, 9).Value    ' Totaal
                n = n + 1
            End If
        Next rij
    End With
    Sheets("Bestellingen").Select
    Application.Goto [A1], True: [A2].Select


End Sub

 

[Niels28]

niet getest ivm ontbreken bijlage

Sub maak()


With ActiveSheet


If .Range("A12:A" & .Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 2012 Then
MsgBox (" Aantal vrije regels in de bestellijst is te klein! ")
Exit Sub
End If

For Each cl In .Range("A12:A" & .Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
If Cells(rij, 1).Value <> 0 Then
With Sheets("bestellingen")
.Cells(cl.Row + 8).Resize(1, 9).Value = cl.Resize(1, 9).Value
End With
End If
Next
End With


End Sub

Niels

 

[wiegerklijnstra]

Hoi Niels. bedankt voor je reactie. Is helaas niet precies wat ik zoek. ik wil namelijk de mogelijk houden zoals in mijn script de cellen apart te kunnen definieeren na de end if. Deze zijn namelijk ergens anders in alle bladen in 1x te veranderen. Ik zal een voorbeeld posten. Ik moet hiervoor echter een hoop strippen gezien de grootte en de vele modules erin.

 

[Niels28]

graag dan eventuele active-x onderdelen ook verwijderen, heb tegenwoordig excel voor mac en die kent geen active-x

Niels

 

[wiegerklijnstra]

Ik heb inmiddels op een nader blad het filter geplaats wat dit probleem ondervangt. Ik sluit de vraag.