kopie range maar lege cellen of cellen met 0 waarde niet kopieeren

[joskjos]

Hallo,

Ik heb de volgende code:

Sub uitvoer()
Sheets("uitvoer").Range("A2:A25").Copy
  Sheets("Invoer").Range("R4").End(xlUp).Offset(1).PasteSpecial xlValues
End Sub

Alleen in deze range A2:A25 komen lege cellen voor. Ik krijg dan in cel R4 enz. allemaal cellen met 0 waarde.
Weet iemand een oplossing in VBA om de 0 waarde / lege cellen niet mee te kopieren?

Mvgr,
Jos

 

[Elsendoorn2134]

Jos,

Ik vermoed dat de cellen in A2:A25 niet leeg zijn maar dat daar een formule in staat die op 0 uitkomt
en dat de 0 wordt onderdrukt op een of andere manier.
Zou de cel inderdaad leeg zou zijn dan word er niets gekopieerd.
Dit kun je oplossen door de formule =ALS(oude formule = 0;"";oude formule) op te nemen in de range A2:A25.

Veel Succes.

 

[joskjos]

Ik heb nu de volgende code maar hier krijg ik foutmelding 13 op type komen niet overeen. Wat zou hier mis kunnen gaan.
De bedoeling is dat cellen met 0 worden gewist maar dat de formule behouden blijft.
Het makkelijkste zou zijn. Cellen met 0 overslaan bij kopiëren en cellen met alle andere waarden kopiëren naar Blad2.

Sub CellenLeegmaken()
For Each cel In Range("A2:R50")
  If cel.Value = "0" Then
    cel.ClearContents xlValues
  End If
Next
End Sub

 

[VenA]

Probeer deze eens

Sub VenA()
With Sheets("Uitvoer").Range("A2:A25")
    .AutoFilter 1, "<>"
    .Copy Sheets("Invoer").Range("R4").End(xlDown).Offset(1)
    .AutoFilter
End With
End Sub

 

[joskjos]

Met autofilter is inderdaad ook een goede oplossing.
Alleen dan zou ik het volgende willen:

Kolom B alle cellen met 0 niet meenemen in de filter.
Dan Kolom A tot en met R 25 kopieren
Deze kolommen met de waarden (geen formules) plakken in Blad invoer en dan beginnen bij kolom B4.
Als het gekopieerd is dan Blad Uitvoer het filter weer wissen.

Is dit ook mogelijk?

 

[VenA]

Kan je even een voorbeeldje plaatsen?

 

[joskjos]

Zie hier even een test bestandje.
In tabblad Uitvoer moet er een filter in kolom B komen. Alle lege cellen en cellen met 0 mogen niet in het filter worden opgenomen.
Dan kolom A2 tot en R25 kopieren naar tabblad invoer.

Bekijk bijlage kopieren gegevens.xlsm

 

[Elsendoorn2134]

Joskjos,

De foutmelding kode 13 ontstaat omdat je een numerieke waarde (0) vergelijkt met een tekst ("0").
De autofilter geeft niet de oplossing voor je probleem omdat dan de tussenliggende cellen niet worden
meegenomen. Handiger is het volgens mij om de hele kolom te kopiëren en daarna alle 0 waardes te
verwijderen, de procedure "Cellen leegmaken" is hiervoor voldoende.

Veel Succes.

 

[VenA]

Probeer deze eens.

Sub VenA()
With Sheets("Uitvoer").Cells(1).CurrentRegion
    .AutoFilter 2, "<>", xlAnd, "<>0"
    .Offset(1).Copy Sheets("Invoer").Range("A2").End(xlUp).Offset(1)
    .AutoFilter 2
End With
End Sub

Hoewel ik denk dat je dit bedoelt.

.Offset(1).Copy Sheets("Invoer").Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1)

 

[joskjos]

Top! Dit is inderdaad wat ik bedoel. De code is ook lekker snel door autofilter!

Bedankt!