Data kopiëren naar variabele rij in zelfde kolom

[wook]

Hallo, ik zit met een probleem en kwam toen deze site tegen. Aangezien ik hier nieuw ben heb ik eerst eens wat rond geneust en toen toch besloten om een topic te starten in de hoop dat iemand mij kan helpen.

Ik wil dmv een druk op de knop, data verplaatsen van de ene cel naar de andere. Echter het is wel zo dat de cel waar het heen gekopiëerd moet worden telkens varieert.

Zie bijlage.

Het tabblad heet 'FC-chk' en wat er moet gebeuren is het volgende. Als ik op een knopje druk, wil ik dat data in cellen D18:K18 gekopieerd wordt naar idem kolom, maar onderin de tabel in de eerst volgend lege vakje. Helemaal het eerst gevulde vakje is het ook weer niet in de bijlage, maar ik kan evt de cellen die 'bovenin' zitten voorzien van een vorm van data.

Dus cel D18 zou naar D61 moeten, E18 naar E62, F18 naar F63, G19 naar G64, etc.

Is dit mogelijk? Elke hulp wordt gewaardeerd.

 

[OctaFish]

Allereerst welkom bij HelpMij! Je krijgt het snelst (en het beste) antwoord als je een voorbeeld bestandje meestuurt; wat je wilt kan alleen met een macro, en daarvoor is een bestandje dus onontbeerlijk.

 

[wook]

Bijlage toegevoegd. Heb er ook wat data ingezet.

 

[HSV]

Ik doe een gokje.

Sub hsv()
Dim sn, j As Long
sn = Range("c18:j18")
 With Cells(Rows.Count, 2).End(xlUp)
  For j = 1 To UBound(sn, 2)
    .Offset(j, j) = sn(1, j)
  Next j
    .Offset(1) = "werkelijk"
 End With
End Sub

 

[wook]

Hoi HSV, denk al een goede zet in de juiste richting. De uitkomst is echter net niet helemaal wat ik verwacht had.
Het uitvoeren van jouw code (op 1 bereikwijziging na) resulteert in een plaatsing van data op een verkeerde plaats.
Heb het eea van een kleurtje voorzien om het duidelijker te maken. De data is op de rode plaatsen terecht gekomen ipv de groene cellen.
Als het helpt zou ik evt een cel kunnen toevoegen waarin een waarde staat die aangeeft op welke regel gestart moet worden. Dus bv als de eerste cel C31 zou moeten zijn, dat hij het regelnummer weet doordat ik ergens de waarde in cel A31 naar voren laat komen. Misschien dat dat helpt?

Ik puzzel nog even verder, maar enig hulp wordt zeker gewaardeerd.

 

[snb]

Sub M_snb()
  sn = Range("c18:k18")
  
  For j = 1 To UBound(sn, 2)
    Cells(Rows.Count, j + 2).End(xlUp).Offset(1) = sn(1, j)
  Next j
  Cells(Rows.Count, 2).End(xlUp).Offset(1) = "werkelijk"
End Sub

 

[wook]

Gelukt!

Het is gelukt! Met de laatste tip en een kleine aanpassing daarin ben ik gekomen waar ik wilde zijn! Hij schreef het woord 'Werkelijk' nog ergens weg, wat niet de bedoeling was.
Verder heb ik het inmiddels uitgebreid, want het ging om 6 tabellen waar dit op toegepast moest worden.

Zo is hij uiteindelijk geworden:

Sub fc_write()

Answer = MsgBox("Weet u zeker dat data weggeschreven moet worden naar onderstaande tabellen?", vbYesNo + vbInformation, "Application Message")
If Answer = vbYes Then Else Exit Sub

  sn = Range("D18:K18")
  
  For j = 1 To UBound(sn, 2)
    Cells(Rows.Count, j + 3).End(xlUp).Offset(1) = sn(1, j)
  Next j
  
  sn = Range("O18:V18")
  
  For j = 1 To UBound(sn, 2)
    Cells(Rows.Count, j + 14).End(xlUp).Offset(1) = sn(1, j)
  Next j
    
  sn = Range("Z18:AG18")
  
  For j = 1 To UBound(sn, 2)
    Cells(Rows.Count, j + 25).End(xlUp).Offset(1) = sn(1, j)
  Next j
      
  sn = Range("AK18:AR18")
  
  For j = 1 To UBound(sn, 2)
    Cells(Rows.Count, j + 36).End(xlUp).Offset(1) = sn(1, j)
  Next j
      
  sn = Range("AV18:BC18")
  
  For j = 1 To UBound(sn, 2)
    Cells(Rows.Count, j + 47).End(xlUp).Offset(1) = sn(1, j)
  Next j
      
  sn = Range("BG18:BN18")
  
  For j = 1 To UBound(sn, 2)
    Cells(Rows.Count, j + 58).End(xlUp).Offset(1) = sn(1, j)
  Next j
        
End Sub

Ik ben er helemaal blij mee, superbedankt! :thumb:

 

[snb]

Nog effe polijsten:

Sub M_snb()
  For Each ar In Range("D18:K18", "O18:V18","Z18:AG18","AK18:AR18","AV18:BC18","BG18:BN18").Areas
    For Each it In ar
        Cells(Rows.Count, it.Column - 1).End(xlUp).Offset(1) = it
    Next
  Next
End Sub

 

[wook]

Dat resulteert in een foutmelding:

 

[snb]

Er staat niets gemarkeerd.

Maar zet de code in ieder geval in de codemodule van het werkblad waarop de code betrekking heeft.

 

[wook]

Hij highlight het woord 'Range'.
Heb de codes ook in het blad opgeslagen waar vandaan ze uitgevoerd worden, maar dat geeft het zelfde resultaat.

zie bijlage.

 

[snb]

Heb je iets beveiligd of cellen samengevoegd ?

 

[wook]

Nee. (zie bijgevoegd bestand)
Moest het bestand wat verkleinen omdat hij mij niet meer dan 100kB liet uploaden.

 

[snb]

Nogal wiedes: je moet foute code niet klakkeloos overnemen:

Sub M_snb()
  For Each it In Range("D18:K18,O18:V18,Z18:AG18,AK18:AR18,AV18:BC18,BG18:BN18").Cells
    Cells(Rows.Count, it.Column).End(xlUp).Offset(1) = it
  Next
End Sub

of

Sub M_snb()
  For Each it In Rows(18).SpecialCells(2)
    Cells(Rows.Count, it.Column).End(xlUp).Offset(1) = it
  Next
End Sub

 

[wook]

Hé thx!

Dat maakt het een stuk simpeler. Ook als ik toekomstig extra tabellen toe wil voegen.
Heb ook gelijk een variant toegevoegd om eenvoudig de laatste ingave te verwijderen.

Het ging fout, omdat ik de code zelf niet kan lezen. Als ik dan bereiken zie die overeen komen met mijn document, dan is dat goed genoeg voor mij. Ik zie ook niet zo snel de gelijkenis tussen wat je in eerste instantie voorstelde en wat er vervolgens kwam.

Het werkt nu in elk geval zoals het hoort.

Erg bedankt!