Macro kolommen kopieeren

[surfingmaster]

Beste dames en heren/

de macro moet twee dingen doen.

Eerst moet de macro de niet lege rijen tellen van kolom A van tabblad 2. Dit zijn het aantal rijen die in tabblad 1 vanaf rij 20 en voor de 2 nalaatste rijen moeten komen te staan. De rijen die ingevoegd worden moeten een kopie van de formules zijn van rij 18.

Daarna moeten er twee kolommen gekopieerd worden, kolom A en E van 'Blad 2'. Deze kopieen moeten dan worden ingevoegd in komol B en C van tabblad 'Blad 1'.

Als voorbeeld heb ik een bijlage toegevoegd.

Alvast bedankt,
Erwin

 

[surfingmaster]

Ik denk dat ik sommige gedeeltes van de macro weet

Voor de rijen te tellen van tabblad twee is de macro:

Sheets("Blad2").UsedRange.Rows.Count

Voor het aantal rijen invoegen vanaf rij 20 en kopieren van rij 18 blad1 is is de macro denk ik:
With Sheets("Blad1")

For i = 1 To [Value] + 20 - .UsedRange.Rows.Count
        .Rows(18).Copy
        .Cells(1, .UsedRange.Rows.Count - 3).Insert
    Next
End With

Alleen weet ik niet of value de juiste verwijzing is naar het aantal getelde rijen in blad2 en hoe ik ze moet samenvoegen, want mij lukt het niet.

Gr,
Erwin

 

[Superzeeuw]

Waarom plaats je de vraag voor een tweede keer?

 

[surfingmaster]

Je hebt gelijk. Wil er dan ook een verwijderen, maar weet niet hoe dat moet

 

[Superzeeuw]

SF,

zet deze vraag dan maar op opgelost dan is het probleem weg

 

[surfingmaster]

Beste Dames en heren.

Ik heb de macro voor een deel opgelost


Deze macro doet het volgende:
De macro telt eerst de bebruikte rijen van van 'Blad2'', daarna die van tabblad 'blad1'. Aan de hand hiervan berekend hij hoeveel regels er aan blad1 moeten worden toegegevoegd. De rijen die worden toegevoegd zijn een copie van regel 18.
Je kan dan de regels van 'Blad 2' kopieeren en meteen invoegen in 'Blad1'

Sub RijenAanpassen()
Application.ScreenUpdating = False
    Sheets("Blad1").Unprotect
    Sheets("Blad2").Unprotect
With Sheets("Blad2 ")
Dim Beg As Integer
 Beg = Sheets("Blad2").UsedRange.Rows.Count
End With
With Sheets("Blad1")
Dim Omz As Integer
 Omz = Sheets("Blad1").UsedRange.Rows.Count
End With
If Beg - (Omz - 28) > 0 Then
Rows("18:18").Copy
 With Sheets("Blad1")
Dim TEL As Integer
TEL = Sheets("Blad1").UsedRange.Rows.Count
Rows(TEL).Offset(-9, 0).Select
Dim rng
rng = Beg - (Omz - 28)
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(rng - 1, 0)).Insert
Selection.EntireRow.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Blad1").Protect
Sheets("Blad2").Protect
Application.ScreenUpdating = True
End With
Else
Sheets("Blad1").Protect
Sheets("Blad2").Protect
Application.ScreenUpdating = True
End If
End Sub

Met vriendelijke groet,
Erwin