met VBA twee cellen kopieren als er een waarde staat.

[MJONK]

Ik heb in een sheet twee kolommen die ik gebruik,

Range E3:E40 kunnen getallen ingevuld staan. Range F3:F40 staat altijd tekst.

Nu zoek ik een stukje code die:
ALS er een waarde staat in range E3:E40 deze waarde, en de tekst in de cel ernaast kopieert.
Vervolgens heb ik een code-regel die dit ergens anders plakt.

Hopelijk kunnen jullie helpen; wat ik tot nu toe heb is het volgende, helaas krijg ik het niet werkend:

Dim cel1 As Variant
    
    
   For Each cel1 In Range("E3:E40")
    If cel1.Value <> "" Then cel1& cel1.Offset(0, 1).Copy
    
     
     
    Range("A" & Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row).PasteSpecial (xlPasteValues)
    
    
    Next

 

[wampier]

Ik denk dat je probeert een nieuwe range te maken door cellen op te tellen? dat gaat niet. Je kunt wel een nieuwe range definiëren aan de hand van cellen die aan de voorwaarden voldoen,

Maar waarom probeer je copy paste te gebruiken? je kunt toch direct de values aan de nieuwe locatie toewijzen?

 

[MJONK]

klinkt goed maar voor mij nog te moeilijk!

Ik ben echt aan het puzzelen om dit werkend te krijgen.

Ik heb een lijst met artikelen,

en alleen als voor een artikel een hoeveelheid staat, dan wil ik de hoeveelheid en de twee kolommen rechts daarvan verplaatsen naar de linkerkant van de sheet, (richting de factuur).

Ik hoop dat je me op weg kunt helpen!

 

[wampier]

Ik dacht eigenlijk aan dit:

Dim location As Range
For Each cell In Range("E1:e10")
    If cell.Value <> "" Then
        Set location = Range("A65000").End(xlUp).Offset(1, 0)
        location.Value = cell.Value
        location.Offset(0, 1).Value = cell.Offset(0, 1).Value
    End If
Next cell

deze code kan wat versneld worden met nocalculate / novisible etc. (let op heb range even aangepast voor test)

 

[MJONK]

Super bedankt! dit is precies wat ik bedoel,

Nu heb ik ook mijn eigen code werkend kunnen krijgen, zie hieronder;
Ik heb het gevoel dat jouw code sneller is, vanwege het achterwege laten van copy/paste

For Each cell In Range("E3:E40")
    If cell.Value <> "" Then
        Range(cell, cell.Offset(0, 2)).Copy
        Range("A" & Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row).PasteSpecial (xlPasteValues)
    End If
    
    
    Next cell
   
End Sub