Cel kopieren met knop en cellen overslaan

[marcel31281]

Geachte forumleden,

Ik kreeg vandaag van mijn planner de vraag of onderstaande mogelijk is,

Als zij een groot project moet plannen kon ze in de oude planning de cellen doortrekken en zo de ingevulde informatie kopiëren.
In de nieuwe planning (zie bijlage) zitten er 2 kolommen tussen waar de informatie niet in gekopieerd moet worden.

Is het mogelijk om de data uit F7 in 1 keer automatisch te kopiëren naar I7, L7, O7 en R7

Ik heb zelf onderstaande al geprobeerd, maar hij neemt in deze ook de opmaak mee, terwijl alleen de tekst gekopieerd moet worden

Sub Kopieren()
'
' Kopieren Macro
'

'
Selection.Copy
Range("I7,L7,O7,R7").Select
ActiveSheet.Paste
End Sub



Alvast bedankt,

Bekijk bijlage Planning 2019 test.xlsm

 

[edmoor]

Probeer deze eens:

Sub Kopieren()
    Range("I7,L7,O7,R7") = Range("F7").Value
End Sub

 

[marcel31281]

Beste Edmoor,

Bedankt dit is inderdaad wat ik bedoel, soms kan de oplossing zo simpel zijn ;-)
Is het eventueel nog mogelijk een universele code te maken, zodat ik hem op alle cellen kan toepassen?

 

[edmoor]

Dat kan, met dit achter het blad WEEK 1:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 6 And Target.Row > 6 Then
        Application.EnableEvents = False
        Cells(Target.Row, "I") = Target.Value
        Cells(Target.Row, "L") = Target.Value
        Cells(Target.Row, "O") = Target.Value
        Cells(Target.Row, "R") = Target.Value
        Application.EnableEvents = True
    End If
End Sub

Iedere wijziging in een cel van kolom F wordt dan doorgekopiëerd naar de andere cellen op dezelfde regel.

 

[marcel31281]

Bedankt voor je reactie,

Alleen moet het gekopieerd worden als dat nodig is, nu gaat het direct als ik in F7 wat invul
Excuses als ik niet duidelijk genoeg was

 

[edmoor]

Er gaat niets boven precisie wat uitleg betreft
Je kan dit achter een knop zetten, of achter een toetscombinatie:

Private Sub CommandButton2_Click()
    If ActiveCell.Column = 6 Then
        Cells(ActiveCell.Row, "I") = ActiveCell.Value
        Cells(ActiveCell.Row, "L") = ActiveCell.Value
        Cells(ActiveCell.Row, "O") = ActiveCell.Value
        Cells(ActiveCell.Row, "R") = ActiveCell.Value
    End If
End Sub

 

[marcel31281]

Super bedankt!!!

 

[marcel31281]

Graag zou ik een aanpassing zien indien mogelijk, ik ben zelf al aan het proberen geweest maar krijg het niet voor elkaar

De bedoeling is dat de opmaak van de tekst meegenomen word met kopiëren

Alvast bedankt

 

[snb]

Alleen moet het gekopieerd worden als dat nodig is

En wat is de specificatie van 'nodig' ?

De bedoeling is dat de opmaak van de tekst meegenomen word met kopiëren
ik ben zelf al aan het proberen geweest maar krijg het niet voor elkaar

Dat betekent dat je zelf totaal geen verstand hebt van VBA.
Dit forum is er niet voor kant-en-klare oplossingen.
Daarvoor zijn er dienstverleners in de markt beschikbaar.

 

[marcel31281]

Door middel van op een knop drukken, onze planner wil maandag tot vrijdag met 1 klik kunnen vullen. zodat ze niet elke cel apart moet invoeren.

Ik heb een klein beetje verstand van vba, maar soms zijn er bepaalde dingen waar ik nog niet uit kom, en ik verplicht mensen niet om mij te helpen het is een vraag.

Plus dat dit een persoonlijk bestand is wat mijn planner wil gaan gebruiken. er is geen enkele zakelijke link verder

 

[edmoor]

Probeer dit maar eens:

Private Sub CommandButton2_Click()
    If ActiveCell.Column = 6 Then
        ActiveCell.Copy Cells(ActiveCell.Row, "I")
        ActiveCell.Copy Cells(ActiveCell.Row, "L")
        ActiveCell.Copy Cells(ActiveCell.Row, "O")
        ActiveCell.Copy Cells(ActiveCell.Row, "R")
    End If
End Sub

 

[HSV]

Je kan ook met union werken @edmoor.

 

[edmoor]

Laat maar zien aan TS

 

[HSV]

Bij deze.

Private Sub CommandButton2_Click()
    If ActiveCell.Column = 6 Then
        ActiveCell.Copy union(Cells(ActiveCell.Row, "I"), Cells(ActiveCell.Row, "L"), Cells(ActiveCell.Row, "O"), Cells(ActiveCell.Row, "R"))
    End If
End Sub

Anders geschreven.

Private Sub CommandButton2_Click()
with ActiveCell
    If .Column = 6 Then
        .Copy union(Cells(.Row, "I"), Cells(.Row, "L"), Cells(.Row, "O"), Cells(.Row, "R"))
    End If
end with
End Sub

 

[edmoor]

Yep
Ik zou het dan voor de leesbaarheid zo schrijven, maar dat is persoonlijk:

Private Sub CommandButton2_Click()
    With ActiveCell
        If .Column = 6 Then
            .Copy Union(Cells(.Row, "I"), _
                        Cells(.Row, "L"), _
                        Cells(.Row, "O"), _
                        Cells(.Row, "R"))
        End If
    End With
End Sub

 

[marcel31281]

Bedankt voor het meedenken, ik ga er mee aan de slag

 

[edmoor]

Maar ik begrijp 1 ding niet. In #1 zeg je dat alleen de tekst gekopieerd moet worden en in #8 zeg je dat ook de opmaak mee moet, terwijl dat kennelijk in #1 al werkte?

 

[marcel31281]

Beste Edmoor,

Dat is inderdaad wel raar.... maar ik weet dat mijn planner bij het testen steeds weer dingen tegenkomt die ze anders of makkelijker wil.

Ben blij dat het in ieder geval nu opgelost is

 

[edmoor]

Ok. Dan heb je nu dus eigenlijk alleen maar een betere code dan in #1