kopieeren Celbereik naar eerste lege cel binnen een bereik

[mud72]

Hallo,

Zit met het volgende probleem. Ik zou via vb een celbereik (c7:e7) willen kopieeren naar een eerst volgende lege cel binnen een bereik. (van i1 tot i6). Nu heb ik al allerlei
codes gevonden maar het probleem is dat ik steeds de data naar de eerst volgend lege cel kopieer in kolom I en niet binnen het bereik (i1:i6)
Kan er iemand mij op weg helpen.

Alvast bedankt.
Bekijk bijlage Test.xlsm

 

[Roncancio]

En wat als alle cellen binnen het bereik gevuld zijn?

Met vriendelijke groet,


Roncancio

 

[mud72]

Dan moet ik een melding krijgen dat de lijst vol is.

 

[Roncancio]

Sub Kopieren()
Set z = Range("I1:I6").Find("", , xlValues, xlWhole)
If Not z Is Nothing Then z.Value = [C7] Else MsgBox "De lijst is vol!"
End Sub

Met vriendelijke groet,


Roncancio

 

[mud72]

Wow snel en mooi , @ Roncancio alvast bedankt.
De code werkt perfect. Heb enkel nog het probleem dat ik niet enkel cel "C7" moet kopieeren maar cellen C7&D7&E7. heb het volgened even geprobeerd maar dat lukt niet

Sub Kopieren()
Set z = Range("I1:I6").Find("", , xlValues, xlWhole)
If Not z Is Nothing Then z.Value = [COLOR="#FF0000"][C7:E7][/COLOR] Else MsgBox "De lijst is vol!"
End Sub

 

[Roncancio]

Alleen als alle waardes van C7 t/m E7 in het bereik geplaatst kunnen worden, worden deze ook daadwerkelijk geplaatst. In alle overige gevallen verschijnt de melding.

Sub Kopieren()
Set z = Range("I1:I6").Find("", , xlValues, xlWhole)
If Not z Is Nothing And z.Row <= 4 Then z.Resize(3, 1).Value = WorksheetFunction.Transpose(Range("C7:E7")) Else MsgBox "De lijst is vol!"
End Sub

Met vriendelijke groet,


Roncancio

 

[mud72]

Ben er bijna. Weer eens geleerd om goed te beschrijven wat je eigenlijk wilt doen.
Code werkt perfect. alleen worden de cellen (C7:E7) nu in I6 onder elkaar opgeslagen en dit zou ook naast elkaar moeten van (I2:K7) tot lijst I2 tot I6 vol is daarna komt de melding
Heb het volgende geprobeerd maar dan krijg ik 3x cel C7 naast elkaar.
@Roncancio mijn excusus als ik niet duidelijk omschrijf wat juist de bedoeling was.

Sub Kopieren()
Set z = Range("I1:I6").Find("", , xlValues, xlWhole)
If Not z Is Nothing And z.Row <= 4 Then z.Resize([COLOR="#FF0000"]1, 3[/COLOR]).Value = WorksheetFunction.Transpose(Range("C7:E7")) Else MsgBox "De lijst is vol!"
End Sub

 

[Roncancio]

Bedoel je het zo?

Sub Kopieren()
Set z = Range("I1:I6").Find("", , xlValues, xlWhole)
If Not z Is Nothing Then z.Resize(1, 3).Value = Range("C7:E7").Value Else MsgBox "De lijst is vol!"
End Sub

Met vriendelijke groet,


Roncancio

 

[mud72]

Bedankt

Yep dit is het helemaal.
@Roncancio hartelijk bedankt voor de hulp en geduld:thumb:ben weeral goed geholpen en kan verder met mijn programma.
Bedankt voor alle hulp