"Wit-regel" auto kleur geven na kopieeropdracht. Kan dat?

[CygneVoler]

Excellers,

Is het mogelijk wanneer ik vanaf tabblad 1 een tekst kopieer, vervolgens plak naar tabblad 2 de regel daarna gekleurd wordt?
Zodat er een duidelijke scheiding "zichtbaar" wordt?

Deze vba code wordt gebruikt om de tekst van blad 1 te kopiëren naar blad 2

Private Sub CommandButton1_Click()
    Dim bstlF As Worksheet
    Dim bsto As Worksheet
    Dim LRbstlF As Long
    Dim LRbsto As Long
    Dim i As Long
    
    
    Set bstlF = Sheets("Bestelformulier")
    Set bsto = Sheets("BestelOverzicht")
    
    With bstlF 'Bestelling vanaf kolom B wordt gekeken naar de hoeveelheid tekst
        LRbstlF = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
    
    For i = 3 To LRbstlF 'i = "cijfer" hiermee bepaal je de regel van waar af de eerste kopie wordt genomen
        With bsto
          
            LRbsto = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            If i = 3 And LRbsto > 3 Then LRbsto = LRbsto + 1 'zorgt voor extra witregel tussen de bestelling
        End With
        bsto.Cells(LRbsto, 2) = bstlF.Cells(i, 2)
        bsto.Cells(LRbsto, 3) = bstlF.Cells(i, 3)
        bsto.Cells(LRbsto, 4) = bstlF.Cells(i, 4)
        bsto.Cells(LRbsto, 5) = bstlF.Cells(i, 6)
        bsto.Cells(LRbsto, 6) = bstlF.Cells(i, 7)
        bsto.Cells(LRbsto, 7) = bstlF.Cells(i, 11)
        bsto.Cells(LRbsto, 8) = bstlF.Cells(i, 12)
        bsto.Cells(LRbsto, 9) = bstlF.Cells(i, 13)
        
        Next i
     
          
End Sub

Alvast bedankt voor jullie hulp.

 

[HSV]

Door netjes in A1 te beginnen gaat het met onderstaande code.

Private Sub CommandButton1_Click()
sn = Cells(1).CurrentRegion
ReDim arr(0 To UBound(sn), 0 To UBound(sn, 2))
For i = 3 To UBound(sn)
   For j = 1 To UBound(sn, 2)
      Select Case j
        Case 1, 2, 3, 5, 6, 10, 11, 12
        arr(n, jj) = sn(i, j)
        jj = jj + 1
      End Select
   Next j
 n = n + 1
 jj = 0
 Next i
   With Sheets("Besteloverzicht").Cells(Rows.Count, 1).End(xlUp)
     .Offset(2).Resize(UBound(arr), UBound(arr, 2)) = arr
     .Offset(1).Resize(, 9).Interior.ColorIndex = 15
   End With
End Sub

 

[CygneVoler]

Dankjewel voor je snelle reactie Harry. Ik heb alleen een paar vragen:
1 waarom is het niet verstandig om een "wit kader" om het document te plaatsen? (regel 2 en kolom 2)
2.Verder zie ik dat je netjes de code hebt aangepast en dat je de grijze regel van bovenaf "plakt". Is ook dat met een speciale reden of kan het simpel de onderste regel worden?
3.Dit is natuurlijk maar een voorbeeld tekst van 7 regels. Als de tekst nu langer wordt, wijzigt dan ook de laatste regel in "grijs"?

 

[HSV]

1: Het vergemakkelijkt de codes als je in Cel A1 begint (ook de telling in de array loopt synchroon met je kolommen).
2: Omdat er aan de onderkant van je gegevens nog geen grijze regel stond dacht ik dat het geplaatst moest worden.
3: Het maakt niet uit hoe lang de lijst wordt; het pakt de laatste rij en daaronder dan de grijze regel als je de code daarvoor aanpast.
Voor 3: Verander de code in:

Private Sub CommandButton1_Click()
sn = Cells(1).CurrentRegion
ReDim arr(0 To UBound(sn) - 3, 0 To UBound(sn, 2) - 1)
For i = 3 To UBound(sn)
   For j = 1 To UBound(sn, 2)
      Select Case j
        Case 1, 2, 3, 5, 6, 10, 11, 12
        arr(n, jj) = sn(i, j)
        jj = jj + 1
      End Select
   Next j
 n = n + 1
 jj = 0
 Next i
   With Sheets("Besteloverzicht").Cells(Rows.Count, 1).End(xlUp)
     .Offset(2).Resize(UBound(arr) + 1, UBound(arr, 2)) = arr
     .Offset(UBound(arr) + 3).Resize(, 9).Interior.ColorIndex = 15
   End With
End Sub

 

[CygneVoler]

Dankjewel werkt top!

 

[HSV]

Mooi dat het goed werkt.

Onderstaande is aangepast om sneller de gegevens op te halen bij meer data.

Private Sub CommandButton1_Click()
sn = Cells(1).CurrentRegion
ReDim arr(0 To UBound(sn) - 3, 0 To UBound(sn, 2) - 1)
For i = 3 To UBound(sn)
   For Each j In Array(1, 2, 3, 5, 6, 10, 11, 12)
        arr(n, jj) = sn(i, j)
        jj = jj + 1
   Next j
 n = n + 1
 jj = 0
 Next i
   With Sheets("Besteloverzicht").Cells(Rows.Count, 1).End(xlUp)
     .Offset(2).Resize(UBound(arr) + 1, UBound(arr, 2)) = arr
     .Offset(UBound(arr) + 3).Resize(, 9).Interior.ColorIndex = 15
   End With
End Sub

 

[CygneVoler]

Lekker bezig Harry; Bedankt!

 

[HSV]

Graag gedaan,

Misschien kun je de vraag nog als opgelost markeren.
Bvd.