• 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.

Excel vba code simpler maken

Status
Niet open voor verdere reacties.
Carloj

Carloj

Gebruiker
Lid geworden
9 feb 2015
Berichten
115
Ik ben bezig met een vba code die de laatste rij kopieert en deze eronder plakt. Dit wordt gedaan ivm met het voorkomen dat de voorwaardelijke opmaak wordt gekopieerd. Ik heb de volgende werkende code:

Code: 
Sub Knop1_Klikken()
'
' Knop1_Klikken Macro
'

'
Dim ws As Worksheet
Dim FinalRow As Long
Set ws = ActiveWorkbook.Sheets("Blad1")

FinalCell = ws.Range("I" & ws.Rows.Count).End(xlUp).Row

ws.Range("F" & FinalCell).Copy
ws.Range("F" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("H" & FinalCell).Copy
ws.Range("H" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("J" & FinalCell).Copy
ws.Range("J" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("K" & FinalCell).Copy
ws.Range("K" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("P" & FinalCell).Copy
ws.Range("P" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("Q" & FinalCell).Copy
ws.Range("Q" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("R" & FinalCell).Copy
ws.Range("R" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("S" & FinalCell).Copy
ws.Range("S" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("T" & FinalCell).Copy
ws.Range("T" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("U" & FinalCell).Copy
ws.Range("U" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("V" & FinalCell).Copy
ws.Range("V" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("W" & FinalCell).Copy
ws.Range("W" & FinalCell + 1).PasteSpecial xlPasteValues
ws.Range("AF" & FinalCell).Copy
ws.Range("AF" & FinalCell + 1).PasteSpecial xlPasteValues
    Range("A1:H2").Select
    Application.CutCopyMode = False
End Sub

Het probleem is dat deze code traag is en ik denk ook dat dit veel simpler kan. Maar hoe?
 
Probeer het zo eens:

Code: 
Sub Knop1_Klikken()
j = Range("I" & Rows.Count).End(xlUp).Row

For Each kolom In Array(6, 8, 10, 11, 16, 17, 18, 19, 20, 21, 22, 23, 32)
    Cells(j + 1, kolom).Value = Cells(j, kolom).Value
Next
End Sub
 
Als je niet zoveel kolommen steeds zou overslaan zou het een stuk sneller kunnen:
Code: 
Range("F" & finalRow + 1 & ":AF" & finalRow + 1).Value = Range("F" & finalRow & ":AF" & finalRow).Value
 
Waarvoor wil je dat ? 2* dezelfde gegevens ?
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan