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
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