Volledige versie bekijken : VBA klonen naar alle lijnen



maertens michae
4 November 2014, 22:43
Kan iemand mij helpen,
om dit in vba excel te clonen naar iedere lijn
zodanig ik dit niet voor enkele 1000 lijnen moet invullen en aanpassen.
Ik heb dit nu voor 2 lijnen geschreven.
waarvoor dank

Sub Copy()
Application.ScreenUpdating = False
If Range("A1") <> "" Then
Worksheets("1").Range("A1").Copy
Worksheets("1").Range("c1").End(xlToRight).Offset(0, 1).PasteSpecial
Worksheets("1").Range("A1").Select
Worksheets("1").Range("A1").Clear
Application.CutCopyMode = True


End If
If Range("A2") <> "" Then
Worksheets("1").Range("A2").Copy
Worksheets("1").Range("c2").End(xlToRight).Offset(0, 1).PasteSpecial
Worksheets("1").Range("A2").Select
Worksheets("1").Range("A2").Clear
Application.CutCopyMode = True
End If


Application.ScreenUpdating = True


End Sub

bucky47
7 November 2014, 22:34
maertens michae,
Ik denk dat je hiermee uit de voeten kunt.
Wijzig de Range naar behoefte


Sub verwijder()
Dim c As Variant
For Each c In Range("A1:A8")
If c <> "" Then
c.Offset(, 1) = c
c.ClearContents
End If
Next
End Sub

"Application.ScreenUpdating = False" zou ik er alléén in zetten als het beeld tijdens de uitvoering knippert.

maertens michae
15 November 2014, 16:47
beste,

de vba is niet volledig naar het geen ik naartoe wil
via de link stuur ik een voorbeeldje
http://users.telenet.be/maertens.michael/excel/Kopie%20van%20optelfunctie2.xls
dit is nu ingesteld over lijn 1 maar dit zou moeten over 2000lijnen gaan.

mvg

bucky47
15 November 2014, 23:22
Ik heb een code, die je achter je worksheet moet plakken.
De code wordt uitgevoerd zodra je in kolom A een waarde hebt geplaatst.

Het is wel zaak dat je de formule in B doortrekt naar beneden, zo ook de nullen in C en D
De formule in B is ook aangepast:

=ALS(AANTAL(E1)=1;SOM('1'!1:1)-(A1+B1);"")




Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Column = 1 Then
Target.copy
Target.Offset(, 1).End(xlToRight).Offset(0, 1).PasteSpecial
Target.Clear
Application.CutCopyMode = True
End If
End If
End Sub

Dit houd wel in dat je de module moet verwijderen, en dus ook de drukknop.

bucky47