Alle gegevens in 1 kolom

[Bozz81]

beste lezers,

ik wil artikel-etiketten maken, via word en samenvoegen.
De database waar het begin is, wil me niet lukken.

Tijdens het rondlezen tussen de posts, kan ik nog veel leren hier. Dus misschien kan iemand mij verder helpen bij het volgende probleem:

De artikelnummers en aantallen worden ingegeven ergens op het blad.
Nu wil ik deze aantallen van de artikelnummers onder elkaar in kolom A hebben geplaatst
(zonder opmaak )

Zelf heb ik het gevoel dat ik iets over het hoofd zie in de andere voorbeelden.

Alvast bedankt voor het meedenken.

 

[ExcelAmateur]

Bozz81,

Kijk eens of dit stukje code, zo wel werkt.

If Range("A3") > 0 Then Range("A3").Copy
  Range("B:B,P3").Activate
  ActiveSheet.Paste

 

[ExcelAmateur]

Ik denk dat je code dit moet zijn.
Helaas ben ik maar een Amateur op dit gebied maar het werkt zo wel.

Sub test()

    Range("O2").copy
    Range("A1,P2").Select
    ActiveSheet.Paste
    
    If Range("O3") > 0 Then Range("O3").copy
      Range("B1,P3").Select
      ActiveSheet.Paste
    
    If Range("O4") > 0 Then Range("O4").copy
      Range("C1,P4").Select
      ActiveSheet.Paste
    
    If Range("O5") > 0 Then Range("O5").copy
      Range("D1,P5").Select
      ActiveSheet.Paste
    
    If Range("O6") > 0 Then Range("O6").copy
      Range("E1,P6").Select
      ActiveSheet.Paste
    
    If Range("O7") > 0 Then Range("O7").copy
      Range("F1,P7").Select
      ActiveSheet.Paste
    
    If Range("O8") > 0 Then Range("O8").copy
      Range("G1,P8").Select
      ActiveSheet.Paste
    
    If Range("O9") > 0 Then Range("O9").copy
      Range("H1,P9").Select
      ActiveSheet.Paste
        
    If Range("O10") > 0 Then Range("O10").copy
      Range("I1,P10").Select
      ActiveSheet.Paste
 
End Sub

 

[Bozz81]

Goedemorgen EA,

Bedankt voor het meedenken!
zoals je het nu hebt beschreven, krijg ik alleen de cellen A1:I1 gevuld.
Range("P1").Value slaat op de hoeveelheden vd artikelen.
En dan nog onder elkaar krijgen.

Gr. Bozz

 

[Bozz81]

Ben al wat verder, met de volgende code

Range("O1").copy
    Range("A1:A" & Range("P1").Value).Select
    ActiveSheet.Paste
    leeg = zoek(1, 1)
    rows.Cells(leeg, 1).Select
    
    If Range("O2") > 0 Then
    Range("O2").copy
    rows.Cells(leeg, 1).Select
    ActiveSheet.Paste
    End If

Maar nu krijg ik de aantallen vd artikelen er niet onder geplakt. Of kan dit ook via een private function? Dus de Range ("P2").Value

 

[HSV]

Bedoel je het zo?

Sub HSV()
 Dim cl As Range, j As Integer
   Columns(1).ClearContents
  For Each cl In Range("O2:O" & Cells(rows.Count, 15).End(xlUp).Row)
   For j = 1 To cl.Offset(, 1).Value
    Cells(rows.Count, 1).End(xlUp).Offset(1) = Cells(cl.Row, 15).Value
  Next j
 Next cl
End Sub

 

[Bozz81]

Harry,

Bedankt!
zo bedoel ik het inderdaad!

Gr. Bozz

 

[Bozz81]

Harry, nog een vraag.
Columns(1).ClearContents
Kan dit ook vanaf cel A2:A?
omdat anders mijn referentie weg is.
Gr.

 

[HSV]

Graag gedaan Bozz,

Het kan zo:

Range("A2:A" & Cells.SpecialCells(xlCellTypeLastCell).Row).ClearContents

Maar ook zo natuurlijk.

Columns(1).ClearContents
    Range("A1") = "Referentie"

 

[Bozz81]

Hartelijk dank!
Allemaal gelukt!