Gegevens uit input tabblad automatisch naar output tabblad

[Bootje94]

Goedemiddag,

Het komt regelmatig voor dat wij voor producten binnen een project product stickers nodig hebben. Op dit moment wordt dit handmatig overgenomen uit de order maar, ondanks mijn beperkte Excel kennis, ben ik ervan overtuigd dat dit sneller moet kunnen. In de bijlage een voorbeeld bestand met op het tabblad 'Input' de gegevens zoals deze direct uit de order worden gekopieerd. Op het tabblad 'Output' de (handmatig) overgenomen gegevens.

Uit het tabblad 'Input' moeten dus per sticker de volgende gegevens gehaald worden:

• Projectnummer
• ZP catalogusnr.
• Lengte
• Aantal lengtes (om de hoeveelheid product stickers te bepalen, dus staat hier 2 dan moet op het tabblad 'Output' twee keer dezelfde sticker komen)

De gegevens die in het tabblad 'Input' geplakt worden kunnen variëren qua hoeveelheid producten per project, aantal projecten, aantal lengtes en lengtes.

Ik hoop dat deze uitleg duidelijk genoeg is.

Alvast bedankt voor alle moeite.

Met vriendelijke groet,
Bo

 

[sylvester-ponte]

Hallo Bo, welkom .
hier een suf subje

Sub Verzamel()
Dim Opl(), Tabel, PrNr, Pt As Integer
Tabel = Sheets(1).Cells(1, 1).CurrentRegion
For rij = 2 To UBound(Tabel)
  If Tabel(rij, 1) = "Projectnummer" Then
    PrNr = Tabel(rij, 3)
  Else
    ReDim Preserve Opl(1, Pt + 3)
    Opl(0, Pt) = "Projectnummer:"
    Opl(1, Pt) = PrNr
    Opl(0, Pt + 1) = "Artikelnummer:"
    Opl(1, Pt + 1) = Tabel(rij, 2)
    Opl(0, Pt + 2) = "Lengte:"
    Opl(1, Pt + 2) = Tabel(rij, 4)
    Pt = Pt + 4
  End If
Next
Sheets(2).Cells(1, 1).Resize(UBound(Opl, 2) + 1, UBound(Opl, 1) + 1) = WorksheetFunction.Transpose(Opl)
End Sub

 

[Bootje94]

Beste Sylvester,

Super, hier ben ik al heel erg mee geholpen!

Weet je toevallig ook of het nog mogelijk is om de stickers zo vaak aan te maken als in de kolom 'Aantal lengtes' staat?
Dus nu wordt alles 1 keer aangemaakt, maar als daar 2 of 4 staat kan de sticker dan ook 2 of 4 keer gemaakt worden?

Alvast bedankt!

Met vriendelijke groet,
Bo

 

[sylvester-ponte]

dit had je zelf ook kunnen verzinnen:

Sub Verzamel()
Dim Opl(), Tabel, PrNr, Pt As Integer
Tabel = Sheets(1).Cells(1, 1).CurrentRegion
For rij = 2 To UBound(Tabel)
  If Tabel(rij, 1) = "Projectnummer" Then
    PrNr = Tabel(rij, 3)
  Else
[COLOR="#FF0000"]    For n = 1 To Tabel(rij, 5)[/COLOR]
      ReDim Preserve Opl(1, Pt + 3)
      Opl(0, Pt) = "Projectnummer:"
      Opl(1, Pt) = PrNr
      Opl(0, Pt + 1) = "Artikelnummer:"
      Opl(1, Pt + 1) = Tabel(rij, 2)
      Opl(0, Pt + 2) = "Lengte:"
      Opl(1, Pt + 2) = Tabel(rij, 4)
      Pt = Pt + 4
[COLOR="#FF0000"]    Next[/COLOR]
  End If
Next
Sheets(2).Range("A:B").ClearContents
Sheets(2).Cells(1, 1).Resize(UBound(Opl, 2) + 1, UBound(Opl, 1) + 1) = WorksheetFunction.Transpose(Opl)
End Sub