VBA Excel 2010 Variabele rijen laten kopiëren naar cellen op ander tabblad

Status
Niet open voor verdere reacties.

Goessie

Gebruiker
Lid geworden
15 okt 2017
Berichten
7
Hallo allemaal,

Eerst en vooral wil ik zeggen dat ik geen gevorderde ben wat betreft VBA. :).

Wat is nu mijn doel. Ik heb een Excel file met een 15-tal rijen waarin bepaalde gegevens worden ingevuld (al dan niet via een lijst of formule...), tot daar geen probleem.
Nu zou ik een knop willen maken (eigenlijk 2, eentje voor Nederlands en eentje voor Frans - Viva België) die
- Vraagt welke rij
- De gegevens van de rij die je invoert dan kopieert naar een ander gemaakt tabblad en deze in bepaalde cellen kopieert. Op dat tabblad staat dan eigenlijk een formulier dat kan worden afgedrukt.

Weet iemand hoe ik hier best aan begin. Ik was er al in geslaagd een knop per rij te maken die dan de gegevens uit die rij kopieert maar bij de tweede cel had ik al en probleem met 'merged cells' waar hij niet kon naar kopiëren. Bovendien lijkt het mij omslachtig om voor elke rij 2 knoppen (eentje naar NL's blad en eentje naar Franstalig) te maken. Dit moet dan ook nog eens voor 12 maanden.

Alvast bedankt te mogen rekenen op jullie expertise :):)

MVG
Sven
 
Welkom op dit forum Goessie,

Samengevoegde cellen zijn een crime voor bewerkingen in Excel en VBA, probeer ze te vermijden en een (klein) voorbeeld bestand maakt het voor iedereen wat inzichtelijker :)
 
Welkom op dit forum Goessie,

Samengevoegde cellen zijn een crime voor bewerkingen in Excel en VBA, probeer ze te vermijden en een (klein) voorbeeld bestand maakt het voor iedereen wat inzichtelijker :)

Ik heb het spijtig genoeg ook al gelezen ondertussen over die merged cells. Heb al eens proberen spelen met de range en dergelijke maar het gaat mijn huidige petje te boven :)
 
Kleine update misschien toch. In het geüploade bestand werden eigenlijk enkel de maanden November en December aangepast. Het 'formulier' staat op tabblad 'sheet 1'. Hiervann zal ik nog een franstalige versie maken. Op de tab 'personeel' staan nog enkele andere gegevens die nodig zijn. Dit is een kladversie die komt van een reeds bestaande file. Waneer ik het werkend krijg, kan ik al eentje maken voor volgend jaar ook uiteraard.
 
Hier heb je vast een begin. Let wel dit werkt niet met samengevoegde cellen

Code:
Sub Macro4()
    
    Sheets("dec 2017  ").Range("A3").Copy
    Sheets("Sheet1").Range("J5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    Sheets("dec 2017  ").Range("B3").Copy
    Sheets("Sheet1").Range("C5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        
    Sheets("dec 2017  ").Range("C3").Copy
    Sheets("Sheet1").Range("C9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    Sheets("dec 2017  ").Range("E3").Copy
    Sheets("Sheet1").Range("G9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    Sheets("dec 2017  ").Range("J3").Copy
    Sheets("Sheet1").Range("D15").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    Sheets("dec 2017  ").Range("F3").Copy
    Sheets("Sheet1").Range("C11").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    Sheets("dec 2017  ").Range("Q3").Copy
    Sheets("Sheet1").Range("J11").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub
 
Of:
Code:
Sub Macro4()
    Rij = 3
    With Sheets("Sheet1")
        .Range("J5") = Sheets("dec 2017  ").Cells(Rij, "A")
        .Range("C5") = Sheets("dec 2017  ").Cells(Rij, "B")
        .Range("C9") = Sheets("dec 2017  ").Cells(Rij, "C")
        .Range("G9") = Sheets("dec 2017  ").Cells(Rij, "E")
        .Range("D15") = Sheets("dec 2017  ").Cells(Rij, "J")
        .Range("C11") = Sheets("dec 2017  ").Cells(Rij, "F")
        .Range("J11") = Sheets("dec 2017  ").Cells(Rij, "Q")
    End With
End Sub

Tevens zijn de spaties in de naam van het blad dec 2017 niet handig.
 
Laatst bewerkt:
Excuus Goessie,

Ik zit nog een beetje te slapen, zie nu pas dat je eerst de rij wilt selecteren, wat natuurlijk logisch is. De code die ik gepost heb, werkt maar voor 1 vast rij en daar heb je dus niet zoveel aan. Ga nog eens verder kijken
 
Excuus Goessie,

Ik zit nog een beetje te slapen, zie nu pas dat je eerst de rij wilt selecteren, wat natuurlijk logisch is. De code die ik gepost heb, werkt maar voor 1 vast rij en daar heb je dus niet zoveel aan. Ga nog eens verder kijken

Dat is inderdaad mijn bedoeling. Je bent alvast superbedankt voor je hulp. Iedereen trouwens!!!
 
Of:
Code:
Sub Macro4()
    Rij = 3
    With Sheets("Sheet1")
        .Range("J5") = Sheets("dec 2017  ").Cells(Rij, "A")
        .Range("C5") = Sheets("dec 2017  ").Cells(Rij, "B")
        .Range("C9") = Sheets("dec 2017  ").Cells(Rij, "C")
        .Range("G9") = Sheets("dec 2017  ").Cells(Rij, "E")
        .Range("D15") = Sheets("dec 2017  ").Cells(Rij, "J")
        .Range("C11") = Sheets("dec 2017  ").Cells(Rij, "F")
        .Range("J11") = Sheets("dec 2017  ").Cells(Rij, "Q")
    End With
End Sub

Tevens zijn de spaties in de naam van het blad dec 2017 niet handig.

Inderdaad hé, dommigheden waar een nitwit zoals ik dus (nog) niet aan denkt.
 
Heb de code aangepast (met dank aan Edmoore).
Met deze code selecteer je eerst de rij die je wilt kopiëren, daarna verwerkt de macro de data naar Sheet1

Code:
Sub Ophalen()

Application.ScreenUpdating = False

Dim Msg, Style, Title, Response, MyString
Title = "Demo MsgBox"
Msg = "Selecteer te kopieren rij"
Style = vbYesNo + vbQuuestion
Title = "Al gedaan? ga door, Nee stop"
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then
Sheets("aug 2016").Select
End If

If Response = vbYes Then
    
    Sheets("aug 2016").Select
    Range("A1") = Sheets("aug 2016").Range("A1").End(xlUp).Value
    Selection.Copy
    Sheets("Blad1").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Sheets("Blad1").Select
Rij = 1
    With Sheets("Sheet1")
        .Range("J5") = Sheets("Blad1").Cells(Rij, "A")
        .Range("C5") = Sheets("Blad1").Cells(Rij, "B")
        .Range("C9") = Sheets("Blad1").Cells(Rij, "C")
        .Range("G9") = Sheets("Blad1").Cells(Rij, "E")
        .Range("D15") = Sheets("Blad1").Cells(Rij, "J")
        .Range("C11") = Sheets("Blad1").Cells(Rij, "F")
        .Range("J11") = Sheets("Blad1").Cells(Rij, "Q")
    End With
Sheets("Sheet1").Select
End If


End Sub
Heb daarvoor wel een hulpblad aangemaakt (Blad1)
 
En nu nog alle selects en selections verwijderen en opschonen die boel.
 
Heb de code aangepast (met dank aan Edmoore).
Met deze code selecteer je eerst de rij die je wilt kopiëren, daarna verwerkt de macro de data naar Sheet1

Code:
Sub Ophalen()

Application.ScreenUpdating = False

Dim Msg, Style, Title, Response, MyString
Title = "Demo MsgBox"
Msg = "Selecteer te kopieren rij"
Style = vbYesNo + vbQuuestion
Title = "Al gedaan? ga door, Nee stop"
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then
Sheets("aug 2016").Select
End If

If Response = vbYes Then
    
    Sheets("aug 2016").Select
    Range("A1") = Sheets("aug 2016").Range("A1").End(xlUp).Value
    Selection.Copy
    Sheets("Blad1").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Sheets("Blad1").Select
Rij = 1
    With Sheets("Sheet1")
        .Range("J5") = Sheets("Blad1").Cells(Rij, "A")
        .Range("C5") = Sheets("Blad1").Cells(Rij, "B")
        .Range("C9") = Sheets("Blad1").Cells(Rij, "C")
        .Range("G9") = Sheets("Blad1").Cells(Rij, "E")
        .Range("D15") = Sheets("Blad1").Cells(Rij, "J")
        .Range("C11") = Sheets("Blad1").Cells(Rij, "F")
        .Range("J11") = Sheets("Blad1").Cells(Rij, "Q")
    End With
Sheets("Sheet1").Select
End If


End Sub
Heb daarvoor wel een hulpblad aangemaakt (Blad1)

Ik ga daarmee meteen eens aan de slag. Bovendien zal ik me eens verder verdiepen in VBA. Dit intrigeert me al lang. Ik hou je zeker op de hoogte van de vorderingen en hoop je te mogen contacteren wanneer ik nog op een obstakel stoot :)
 
Waarom niet alles in 1 tabel? Al die samengevoegde cellen en verborgen kolommen maken het er ook niet eenvoudiger op. Om op de vraag terug te komen lijkt mij dit voldoende

Code:
Sub VenA()
  ar = Sheets("dec 2017  ").Cells(1).CurrentRegion.Resize(, 17)
  j = InputBox("Welke rij?", "Kies rij")
  With Sheets("Sheet1")
    .Range("J5") = ar(j, 1)
    .Range("C5") = ar(j, 2)
    .Range("C9") = ar(j, 3)
    .Range("G9") = ar(j, 5)
    .Range("D15") = ar(j, 10)
    .Range("C11") = ar(j, 6)
    .Range("J11") = ar(j, 17)
  End With
End Sub
 
Er schiet nog iets te kort aan de laatste code.

Code:
j = Application.InputBox("Welke rij?", "Kies rij", , , , , , 1)
  if j > 0 and j <= ubound(ar) then
 
Ik vind persoonlijk dat elke code dat moet zijn. ;)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan