Opgelost Bepaalde cellen in een specifieke rij kopiëren met VBA

[TheHusky]

Goedemiddag,

ik heb een Excel-bestand met een Command-click button op Blad1.
Wat ik graag zou willen is dat als ik op de button klik, er een vraag verschijnt: Welke rij wil je kopiëren?
Ik kies dan bijvoorbeeld voor rij 7.

Vervolgens kopieert Excel bepaalde cellen uit deze rij naar een ander werkblad (A7 t/m F7, I7 t/m N7)
Is er iemand die weet hoe de VBA code er dan uit moet zien?
De code voor het kopiëren van cellen heb ik al, maar ik zou graag daarvoor willen aangeven welke rij er kopieert moet worden.
Anders heb ik op elke regel een button en dat wil ik niet.

Alvast bedankt voor de reacties!

Groet,
Wilco.

 

[AHulpje]

Plak deze achter het werkblad en ken hem toe aan de button:

Sub KopieerRij()
    If MsgBox("Wilt u de geselecteerde rij " & ActiveCell.Row & " kopieren?", vbYesNo) = vbYes Then
        'Hier de code om de cellen te kopieren
    End If
End Sub

 

[snb]

Dit lijkt me handiger

Sub M_snb()
   If Not Application.InputBox("selecteer de rij", "snb", , , , , , 8) Is Nothing Then         'Hier de code om de cellen te kopieren
End Sub

 

[TheHusky]

Dank voor jullie hulp!
De inputBox is gelukt, maar nu heb ik een volgend 'probleem' waar ik niet over nagedacht heb.

In mijn VBA code staat de code voor een bepaalde regel (in dit geval A7, B7, C7, etc.).
Dit moet natuurlijk op basis van de ingevoerde gegevens van de inputbox zijn.
Aangezien ik een leek ben op VBA zal deze code vast makkelijker kunnen.

Ik heb een fictief bestandje gemaakt en deze als bijlage toegevoegd.
De button staat op Blad1, met de opgegeven rij zou ik alle lichtblauwe cellen willen kopiëren naar Blad2 (in de lichtblauwe kolommen).
Uiteraard gaat het voor regel 7 wel goed omdat dit zo ingesteld staat in de VBA code, maar hoe doe ik het voor bijvoorbeeld regel 17?
En dan moet deze ook niet een bestaande regel op Blad2 overschrijven, maar op de eerstvolgende lege regel plaatsen.

Alvast bedankt!

Groet,
Wilco.

 

[AHulpje]

Probeer het eens zo:

Private Sub CommandButton1_Click()
    Dim rng As Range
    On Error Resume Next
    Set rng = Application.InputBox("Selecteer welke rij er gekopieerd moet worden", "Naar onderzoek", , , , , , 8)
    If rng Is Nothing Then Exit Sub
    rij1 = rng.Row
    On Error GoTo 0
    
    With Sheets("Blad2")
        rij2 = .Range("A6").CurrentRegion.Row + .Range("A6").CurrentRegion.Rows.Count
        Cells(rij1, "A").Copy .Cells(rij2, "A")
        Cells(rij1, "B").Copy .Cells(rij2, "B")
        Cells(rij1, "C").Copy .Cells(rij2, "C")
        Cells(rij1, "D").Copy .Cells(rij2, "E")
        Cells(rij1, "E").Copy .Cells(rij2, "G")
        Cells(rij1, "G").Copy .Cells(rij2, "H")
        Cells(rij1, "H").Copy .Cells(rij2, "K")
        Cells(rij1, "I").Copy .Cells(rij2, "L")
        Cells(rij1, "K").Copy .Cells(rij2, "N")
        Cells(rij1, "M").Copy .Cells(rij2, "O")
        Cells(rij1, "O").Copy .Cells(rij2, "R")
        Cells(rij1, "P").Copy .Cells(rij2, "S")
        Cells(rij1, "Q").Copy .Cells(rij2, "T")
        Cells(rij1, "R").Copy .Cells(rij2, "U")
    End With
End Sub

 

[TheHusky]

Dankjewel!
Alleen werkt het nu alleen bij de eerste keer (willekeurige regel).
Kun je het ook zo maken dat elke volgende regel die ik met de knop wil kopiëren onder de vorige komt te staan op Blad2?

Alvast dank!

Groet,
Wilco.

 

[TheHusky]

@AHulpje: Excuses, het werkt goed! Ik had op Blad2 al een aantal rijen in een tabel staan... daar werden ze onder gezet.
Ik heb de overbodige rijen verwijderd en nu zet hij ze er goed onder.

Veel dank voor je hulp!!
Ik zet het topic op "opgelost".

Groet,
Wilco.

 

[snb]

Het is niet verstandig in een database een record te verplaatsen/verwijderen.
Markeer het record als 'afgewerkt/ klaar/volledig/verwerkt/etc.... '
Dan wordt die eenvoudig weggefilterd als je de lopende records wil zien met autofilter of advancedfilter.

Als je wil volharden in je snode plan gebruik dan:

Sub M_snb()
   On Error Resume Next
   Application.InputBox("selecteer de rij", "snb", , , , , , 8).Copy Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End Sub