Wegschrijven van cellen als bepaalde waarde

[edsel_nl]

Beste Helpmijers,

Het is de bedoeling dat wanneer de waarde in kolom "B" hoger is dan 0. Dat dan de corresponderende omschrijving (kolom A) en het aantal (Kolom B) gekopieerd wordt naar Blad2. NIET de gehele rij. Ik ben wel een aantal vragen hieromtrent tegengekomen maar in die gevallen werd de gehele rij gekopieerd. De onderstaande code werkt alleen dient deze nog te worden aangevuld met het kopiëren.

Public Sub Wegschrijven()
Dim WSh As Worksheet
Set WSh = Worksheets("Blad2")
Sheets("Blad1").Select
For rij = 2 To 100
If Cells(rij, 2) > 0 Then 'HIER CODE VOOR WEGSCHRIJVEN
Next rij
End Sub

 

[DCTALK]

Edsel,

Ik weet niet precies wat de bedoeling van database is maar misschien kun je hier wat mee

plaats in blad 2 de volgende formule, in cell a kan dat en cell b

=ALS(Blad1!B2>6;Blad1!B2) als de waarde hoger is dan 6 dan neemt ie het over dus als er 7 staat komt in blad2 ook 7 te staan\

hopelijk heb ik je goed begrepen en kun je er wat mee

groeten DC

 

[edsel_nl]

Beste DC,

Het is de bedoeling dat alleen de cellen vanuit blad1 naar blad2 gekopieerd worden die voldoen aan de voorwaarde. Zodat deze netjes onder elkaar komen te staan zonder lege cellen. Normaal gesproken zou je dit ook kunnen doen met de filter functie echter kan dit nu niet aangezien in blad 2 in kolom C, D, enz. andere gegevens staan die daar vast staan.

 

[trucker10]

Beste DC,

Het is de bedoeling dat alleen de cellen vanuit blad1 naar blad2 gekopieerd worden die voldoen aan de voorwaarde. Zodat deze netjes onder elkaar komen te staan zonder lege cellen. Normaal gesproken zou je dit ook kunnen doen met de filter functie echter kan dit nu niet aangezien in blad 2 in kolom C, D, enz. andere gegevens staan die daar vast staan.

Kan je hierop verder bouwen ?

Sub wegschrijven()
Dim c As Range
    Application.ScreenUpdating = False
        For Each c In [B2:B100]
        If c >= 0 Then
        
        With Range("A:B")
            c.Rows.Rows.Copy
            
           ['Blad2'!A65536].End(xlUp).Offset(1, 0).Insert Shift:=xlDown
         End With
    End If
Next
   Application.ScreenUpdating = True
End Sub

 

[danny147]

Beste trucker10

Bij mij schrijft hij enkel kolom B weg en zet deze in kolom A in tabblad2.

Groetjes Danny. :thumb:

 

[trucker10]

Beste trucker10

Bij mij schrijft hij enkel kolom B weg en zet deze in kolom A in tabblad2.

Groetjes Danny. :thumb:

Vandaar " Kan je hierop verder bouwen ? " ik heb het ook nog niet voor elkaar , ofwel is het de volledige rij " entireRow " ik heb nu pas nog een andere topic waar ik aangemeld was afgemaakt ( we missen onze Rudi )

 

[edsel_nl]

Beste Daniël,

Bedankt, dat is een stap in de goed richting. Ik heb geprobeerd het werkend te krijgen door het een en ander aan te passen maar krijg het ook niet voor elkaar. Zou je er nog een keer naar willen kijken.

 

[danny147]

Beste trucker10

( we missen onze Rudi )

Doe wordt straks wakker, onze warme bakker

Wigi en Roncancio zijn er ook nog en andere natuurlijk.

Groetjes Danny. :thumb:

 

[snb]

En niet te vergeten:

Public Sub Wegschrijven()
  For each cl in Sheets("Blad1").usedrange.columns(2)
    If cl.[COLOR="Red"]value [/COLOR]> 0 Then cl.offset(,-1).resize(,2).copy sheets("Blad2").cells(rows.count,1).end(xlup).offset(1)
  Next
End Sub

 

[edsel_nl]

Beste snb, excel geeft fout 13 wanneer ik uw code in excel invoer: typen komen niet met elkaar overeen bij (If cl > 0 Then).

 

[snb]

vorige code aangepast.

 

[edsel_nl]

vorige code aangepast.

Doet het helaas nog steeds niet heb de code opgenomen in het bijgevoegde bestand.

 

[danny147]

Beste edsel_nl

Probeer deze code eens.

Public Sub Wegschrijven()
Dim cl As Range
  For Each cl In Sheets("Blad1").Range("B2:B100")
    If cl.Value > 0 Then cl.Offset(, -1).Resize(, 2).Copy Sheets("Blad2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
  Next
End Sub

Groetjes Danny. :thumb:

 

[edsel_nl]

Super bedankt :thumb: Danny en snb!

Deze code werkt perfect. :thumb:

 

[snb]

Doet het helaas nog steeds niet heb de code opgenomen in het bijgevoegde bestand.

Is 'wat' magere feedback voor hulpverleniers.
Leer je aan om aan te geven:

- welke foutmelding je krijgt
- op welke regel de VBA-code stokt
- wat je zelf nog hebt gewijzigd aan de code