Bitte um VBA Hilfe
Wie kann man in einem anderen Tabellenblatt zum Beispiel aus Tabelle 1 in der Tabelle 2 nur die gefüllten
Zellen alle mit Rahmenlinien versehen?
Vielen Dank für Eure Hilfe
Gruß Gerhard
Public Sub rahmen()
With Worksheets("Tabelle2").UsedRange.SpecialCells(2, 23)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
End Sub
Gruß Werner' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lngRow As Long, objRange As Object
If WorksheetFunction.CountA(Rows(Target.Row)) = 0 Then
Exit Sub
Else
Cancel = True
End If
With Worksheets("Tabelle2")
If IsEmpty(.Range("A1")) Then
lngRow = 1
Else
lngRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
.Rows(lngRow).Value = Target.EntireRow.Value
Set objRange = .Rows(lngRow).SpecialCells(xlCellTypeConstants)
If Not objRange Is Nothing Then
With objRange
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End If
End With
Set objRange = Nothing
End Sub