Bereik kolommen kopieren naar andere tabblad

[surfingmaster]

Beste dames/heren,

ik ben op zoek naar een macro die het bereik van kolom A en E van 'Blad2' alleen de waarden kopieert naar 'Blad1' in kolom B en C vanaf regel 20.

Met vriendelijke groet,
Erwin

 

[Superzeeuw]

SF,

Je bent lekker bezig!

Dit is al de derde vraag over hetzelfde.
In je eerste vraag heb ik een mogelijkheid tot oplossing aangedragen.
Vervolgens open je een nieuwe vraag die je wilt weggooien het commentaar is daar zet hem op opgelost.
Vervolgens gaat je doodleuk met die vraag verder en tot slot stel je de vraag voor de derde keer.

????????????????????????

Blijf bij je vraag dan krijg je meer hulp dan op deze manier, hier schiet je niks mee op.

 

[Warme bakkertje]

Gooi er eens een voorbeeldbestandje in zodat we een idee krijgen van de opzet van je werkbladen

 

[Superzeeuw]

@ Rudi,

Kijk ook hier eens:

Zelfde vraag

Zelfde vraag waar al antwoord op gegeven is

 

[Warme bakkertje]

Erwin, kiik eens hoever je hiermee komt

Sub tst()
usedrows = Sheets("Blad2").UsedRange.Rows.Count
With Sheets("Blad1")
    For i = 1 To usedrows
        .[k65536].End(xlUp).Offset(-3).EntireRow.Insert
    Next
    .[M18:AA18].Copy .[M21]
    .[M21].Resize(usedrows - 1, 15).FillDown
    .[C20].Resize(usedrows) = [Blad2!A1].Resize(usedrows).Value
    .[D20].Resize(usedrows) = [Blad2!E1].Resize(usedrows).Value
End With
End Sub

 

[huijb]

@Lode2008 Graag een eigen vraag maken a.u.b. Het is niet netjes om in een ander zijn of haar vraag jouw probleem aan de orde te stellen. Bovendien is het verwarrend voor de helpers en de oorspronkelijke vragensteller.

 

[surfingmaster]

Rudi bedankt voor je antwoord, hij voegt niet de juiste aanral rijen toe. Hij voegt er te veel toe.

Ik heb een voorbeeld bestand bijgevoegd, zodat je kan zien wat ik bedoel.

 

[trucker10]

Je moet de reeds ingevulde cellen aftrekken van de in te vullen cellen , heb ik gedaan via een formule in A1

=AANTALARG(C20:C30)

je kan deze hulpcel ook ergens anders plaatsen !
en dan aanpassen van de macro

 For i = 1 To usedrows - [A1]

 

[huijb]

Off topic berichten verwijderd.

 

[surfingmaster]

Trycker10, bedankt voor je antwoord. Heb de macro nog iets aangepast. Het werkt nu goed.

Dit is de macor nu:

Sub tst()
Application.ScreenUpdating = False
With Sheets("Blad1")
Dim Aantal As Integer
Aantal = Sheets("Blad1").UsedRange.Rows.Count
End With
usedrows = Sheets("Blad2").UsedRange.Rows.Count
With Sheets("Blad1")
    For i = 1 To usedrows - Aantal + 28
        .[k65536].End(xlUp).Offset(-9).EntireRow.Insert
    Next
    .[M18:AA18].Copy .[M21]
    .[M21].Resize(usedrows - 1, 15).FillDown
    .[B20].Resize(usedrows) = [Blad2!A1].Resize(usedrows).Value
    .[C20].Resize(usedrows) = [Blad2!E1].Resize(usedrows).Value
End With
Application.ScreenUpdating = True
End Sub

Groet,
Erwin

 

[trucker10]

surfingmaster :thumb: voor het posten van je macro , met twee zie je meer ( weet ) je meer dan alleen .
Het belangrijkste is dat je het werkende hebt .
suc6 .

 

[surfingmaster]

Ik heb nog een vraag, hoe kan ik de waarde & de opmaak overnemen van de kolommen. De macro neemt nu alleen de waarde over.

Zie macro:

With Sheets("Blad1")
    For i = 1 To usedrows - Omzet + 28
        .[k65536].End(xlUp).Offset(-9).EntireRow.Insert
    Next
    .[M18:ZZ18].Copy .[M21]
    .[M21].Resize(usedrows - 1, 15).FillDown
    .[B20].Resize(usedrows) = [Begroting!A1].Resize(usedrows).[B]Value[/B]
    .[C20].Resize(usedrows) = [Begroting!E1].Resize(usedrows).[B]Value[/B]
End With

Gr,
Erwin

 

[Warme bakkertje]

Sub tst()
Application.ScreenUpdating = False
Dim Aantal As Integer, usedrows As Integer
Aantal = Sheets("Blad1").UsedRange.Rows.Count
usedrows = Sheets("Blad2").UsedRange.Rows.Count
With Sheets("Blad1")
    For i = 1 To usedrows - Aantal + 28
        .[k65536].End(xlUp).Offset(-9).EntireRow.Insert
    Next
    .[M18:AA18].Copy .[M21]
    .[M21].Resize(usedrows - 1, 15).FillDown
    [Blad2!A1].Resize(usedrows).Copy
    With .[B20]
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
    [Blad2!E1].Resize(usedrows).Copy
    With .[C20]
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub

 

[surfingmaster]

Bedankt Rudi,

maar nu wil ik ook nog dat de waarden die ingevuld worden in rij B de achergrond kleur: Color = 12976127
krijgen.

Erwin

 

[trucker10]

en wat als je deze erbij doet ?

With .[B20]
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        .Interior.Color = 12976127
    End With

Kan niet testen

 

[surfingmaster]

Als ik de onderstaande code toepas krijgt alleen cel B20 de achtergrondkleur:12976127. De andere rijen die toegevoegd zijn moeten ook die kleur krijgen.

With .[B20]
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        .Interior.Color = 12976127
    End With

Om het duidelijker te maken heb ik een voorbeeldbestand toegevoegd.

Gr,
Erwin

 

[Warme bakkertje]

Range("B20:B" & Cells(Rows.Count, 3).End(xlUp).Row - 2).Interior.Color = 12976127

 

[surfingmaster]

Bedankt Rudi,

het werkt uitstekend.

Gr,
Erwin