Cellen selecteren en opmaken?

[Demeter]

Ik ben bezig om met een formulier waarbij ik data kopieer van het ene blad naar het andere. Deze gekopieerde data komen te recht in niet opgemaakte cellen. Deze cellen zie ik graag met een opmaak.

Nu heb ik de volgende code bedacht:

Sub Opmaak()
Dim x As Long, n As Long, y As Long
Application.ScreenUpdating = False
With ActiveSheet
x = Cells(Rows.Count, "A").End(xlUp).Row
For n = 1 To x
If Range("A" & n) <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Range("A1").Select
End If
Next n
End With
Application.ScreenUpdating = True
End Sub

Loop nog al te *****n met het selecteren van het bereik wat ik wil hebben.
Dit moet worden: alle gevulden cellen op de regels vanaf A3 t/mA30 en dan van A35 t/m A50 (hier kom ik nog niet aan toe, omdat de test niet werkt). Zou iemand mij de juiste richting op willen sturen?


Bijvoorbaat dank,
Ferenc

 

[Wigi]

Voilà Ferenc

Sub Opmaak()
Dim c As Range
Application.ScreenUpdating = False

For Each c In Application.Union(Range("A3:A30"), Range("A35:A50"))
    
    If c <> "" Then
        c.Borders(xlDiagonalDown).LineStyle = xlNone
        c.Borders(xlDiagonalUp).LineStyle = xlNone
        
        c.Borders(xlEdgeLeft).LineStyle = xlContinuous
        c.Borders(xlEdgeLeft).Weight = xlThin
        c.Borders(xlEdgeLeft).ColorIndex = xlAutomatic
        
        c.Borders(xlEdgeTop).LineStyle = xlContinuous
        c.Borders(xlEdgeTop).Weight = xlThin
        c.Borders(xlEdgeTop).ColorIndex = xlAutomatic
                
        c.Borders(xlEdgeBottom).LineStyle = xlContinuous
        c.Borders(xlEdgeBottom).Weight = xlThin
        c.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        
        c.Borders(xlEdgeRight).LineStyle = xlContinuous
        c.Borders(xlEdgeRight).Weight = xlThin
        c.Borders(xlEdgeRight).ColorIndex = xlAutomatic
        
        c.Borders(xlInsideVertical).LineStyle = xlNone
    End If
Next
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Wigi

 

[Demeter]

Whoeha.

Wigi,

Fantastisch zo snel. Whoeha.:shocked:

Thanks,
Ferenc

 

[Wigi]

Als je het principe doorhebt hoe je naar cellen moet verwijzen, dan is het poepsimpel...

Graag gedaan Ferenc

 

[jheesterbeek]

For Each c In Application.Union(Range("A3:A30"), Range("A35:A50"))

Kun je me uitleggen wat .Union doet?

 

[Wigi]

Het voegt die twee bereiken samen.

 

[jheesterbeek]

Bedankt, :thumb:
schitterend zo'n forum, je blijft ervan leren