• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Aanpassing code met selecteren kolommen

Status
Niet open voor verdere reacties.

mvanbe

Gebruiker
Lid geworden
7 mrt 2018
Berichten
87
Goedemiddag,

Ik heb een stukje code die aangepast moet worden en ik kom er helaas niet uit. Het is de bedoeling dat deze geplitst wordt in de kolommen die gekopieerd worden. Dit in 2 secties; B t/m E en G t/m L

Ofwel F moet niet gekopieerd worden. De geselecteerde kolommen dienen wel aansluitend geplakt te worden. Een voorbeeld bestand is wat lastig te produceren dus hoop dat het zo kan en mag.

Hoop dat iemand mij kan helpen. Alvast dank!



Code:
Sub kopieerBasismodel_deelbedragen()
    Set ws = wsRekenmodelDeelbedragen
             
    With ws
        endRow = .Cells(.Rows.Count, "E").End(xlUp).Row + 1 'Onderste rij van kolom E
    End With
    
         
    colStart = "B"
    colEnd = "L"
    
    ws.Range(colStart + CStr(Range("setting_startrij_rekenmodel")) + ":" + colEnd + CStr(endRow)).Copy
        
End Sub
 
Toevoeging: ik heb het zelf met de recorder op deze manier opgelost; het werkt maar volgens mij niet de meest charmante manier. Als iemand nog een aanvulling heeft graag :)


Code:
Sub kopieer_deelbedragen2()

Application.ScreenUpdating = False
 
    Range("B8:E2500").Copy
    
    Sheets("Rekenmodel").Select
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    Sheets("Basismodel met Deelbedragen").Select
    Range("G8:L2500").Copy
   
    Sheets("Rekenmodel").Select
    Range("F8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("B8").Select
    
Application.ScreenUpdating = True
    
End Sub
 
een optie

Code:
Sub VenA()
  With Sheets("Basismodel met Deelbedragen")
    lr = Application.Max(8, .Cells(Rows.Count, 2).End(xlUp).Row)
    Union(.Range("B8:E" & lr), .Range("G8:L" & lr)).Copy
  End With
  Sheets("Rekenmodel").Cells(8, 2).PasteSpecial xlPasteValues
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan