Kopieren naar eerstvolgende lege cel

[fredmel]

Hoi

Ik heb een bestandje met gegevens die ik wil bewaren in een werkblad
deze moeten elk op een lege regel komendus bijv a2..j2 moet naar regel 5, de volgende aut naar regel 6 dan naar regel 7 enz enz (waarbij a2..a7 steeds andere informatie is)

Hoe moet ik dit aanpakken

mvg Fred :thumb:

 

[Wigi]

Hoi

Ik heb een bestandje met gegevens die ik wil bewaren in een werkblad
deze moeten elk op een lege regel komendus bijv a2..j2 moet naar regel 5, de volgende aut naar regel 6 dan naar regel 7 enz enz (waarbij a2..a7 steeds andere informatie is)

Hoe moet ik dit aanpakken

mvg Fred :thumb:

Ik heb het niet verstaan. Maak eens een voorbeeldbestandje met de nodige uitleg.

Wigi

 

[fredmel]

1 1 1 1 1 1 1 1 1

de getallen 1 moeten in regel 10 terechtkomen, als ipv 1 een 2 komt moeten deze gegevens in regel 11
komen en devolgende gegevens in 12 dit wel aut met bijv eenmacro
dit moet dus een soort database worden
in het voorbeeld zou dus 5 in devolgende lege regel moeten komen dus regel 14
hierbij wel in acht genomen dat de getallen fictief zijn dus in het echt zijn het gegevens

1 1 1 1 1 1 1 1 1
2 2 2 2 2 2 2 2 2
3 3 3 3 3 3 3 3 3
4 4 4 4 4 4 4 4 4

 

[Wigi]

Dus als er 1 2 3 4 5 6 7 8 9 staat in een rij, hoe moet dat dan worden? En wat met getallen die niet opeenvolgend zijn, zoals 1, 2, 5?

 

[Withaar]

Fredmel,

Bedoel je zo iets?

Code in de macro onder de button:
Sub toevoegen()
Dim x, y As Integer
Dim w, z As String
x = 2
w = ""
' vind laatste lege rij
Do
x = x + 1
'Een rij is leeg als geen van de cellen A t/m J een waarde bevatten
w = Cells(x, 1) & Cells(x, 2) & Cells(x, 3) & Cells(x, 4) & Cells(x, 5) & Cells(x, 6) & Cells(x, 7) & Cells(x, 8) & Cells(x, 9) & Cells(x, 10)
Loop Until w = ""
'copy range
Range("A2:J2").Select
Selection.Copy
Cells(x, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2:J2").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
End Sub

 

[Wigi]

Fredmel,

Bedoel je zo iets?

Code in de macro onder de button:
Sub toevoegen()
Dim x, y As Integer
Dim w, z As String
x = 2
w = ""
' vind laatste lege rij
Do
x = x + 1
'Een rij is leeg als geen van de cellen A t/m J een waarde bevatten
w = Cells(x, 1) & Cells(x, 2) & Cells(x, 3) & Cells(x, 4) & Cells(x, 5) & Cells(x, 6) & Cells(x, 7) & Cells(x, 8) & Cells(x, 9) & Cells(x, 10)
Loop Until w = ""
'copy range
Range("A2:J2").Select
Selection.Copy
Cells(x, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2:J2").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
End Sub

Cees

ik ben ervan overtuigd dat jouw code werkt, maar dit lijkt me beter:

Sub toevoegen()
Dim rngValues As Range, LastRow As Long
Application.ScreenUpdating = False
Set rngValues = Range("A2:J2")  'enkel moet je aanpassen als de code voor een ander bereik gebruikt wordt, niets anders
If WorksheetFunction.CountBlank(rngValues) = rngValues.Count Then
    MsgBox "Geen ingevulde cellen."
    Exit Sub
Else
    LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row
    Range("A2:J2").Copy
    Range("A" & LastRow + 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    rngValues.ClearContents
    rngValues.Cells(1).Select
End If

Wigi

 

[Withaar]

@Wigi,

Cees? Ik heet geen Cees hoor.

En code kan natuurlijk altijd anders, mag duidelijk zijn dan ik niet aan de hoge school van het macro's doe, maar al doende leer men.

 

[Wigi]

@Wigi,

Cees? Ik heet geen Cees hoor.

Sorry dan ben ik

Ik moet jou verwarren met iemand anders...

Hopelijk doe ik het nu niet meer fout.

 

[Wigi]

En code kan natuurlijk altijd anders, mag duidelijk zijn dan ik niet aan de hoge school van het macro's doe, maar al doende leer men.

Dat is idd de bedoeling. Ik probeer mijn kennis wat door te geven zodat anderen er ook wat aan hebben

 

[fredmel]

Hoi

Ben al blij met de reacties die ik krijg hierop
Ga als het goed is binnenkort op cursus acces dus hoop dan de diepere betekenissen te kunnen doorgronden van alles wat hierboven staat (ga wel nakijken wat dit allemaal betekent)
Het werkt in ieder geval zoals ik het inderdaad wil
het enige wat nog niet goed werkt is eigenlijk alles wat in a2..j2 staat ook zo gecopieerd moet worden dus inclusief opmaak en de tijd cq datum aanduiding

bijv in een cel staat een datum en in een andere cel ztaat een tijd, normaal met copie gaat dit gewoon mee maar nu niet de tijd en datum is een getal geworden en de opmaak is ook niet mee genomen maar geeft een leeg veld aan

mvg Fred :thumb: :thumb:

 

[Wigi]

Hoi

Ben al blij met de reacties die ik krijg hierop
Ga als het goed is binnenkort op cursus acces dus hoop dan de diepere betekenissen te kunnen doorgronden van alles wat hierboven staat (ga wel nakijken wat dit allemaal betekent)

Fred

dit is Excel, geen Access... Alhoewel er overlappingen zijn.

Het werkt in ieder geval zoals ik het inderdaad wil
het enige wat nog niet goed werkt is eigenlijk alles wat in a2..j2 staat ook zo gecopieerd moet worden dus inclusief opmaak en de tijd cq datum aanduiding

bijv in een cel staat een datum en in een andere cel ztaat een tijd, normaal met copie gaat dit gewoon mee maar nu niet de tijd en datum is een getal geworden en de opmaak is ook niet mee genomen maar geeft een leeg veld aan.

Doe dan dit:

Sub toevoegen()
Dim rngValues As Range, LastRow As Long
Application.ScreenUpdating = False
Set rngValues = Range("A2:J2")  'enkel moet je aanpassen als de code voor een ander bereik gebruikt wordt, niets anders
If WorksheetFunction.CountBlank(rngValues) = rngValues.Count Then
    MsgBox "Geen ingevulde cellen."
    Exit Sub
Else
    LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row
    With rngValues
        .Copy Range("A" & LastRow + 1)
        .ClearContents
        .Cells(1).Select
    End With
End If
End Sub

Wigi

 

[fredmel]

Wigi

Bedankt dit is precies wat ik zocht :thumb:

 

[Wigi]

Wigi

Bedankt dit is precies wat ik zocht :thumb:

OK, zet de vraag dan op opgelost.

Goed weekend nog.

Wigi