01.06.2015, 16:44
Hallo,
ist es möglich folgen den Code anzupassen, so daß evtl. Zellfarben der Blätter auch mit übenommen werden?
Danke und Gruß
Thomas
ist es möglich folgen den Code anzupassen, so daß evtl. Zellfarben der Blätter auch mit übenommen werden?
Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim i As Long
Dim varQ As Variant
If Sh.Name = "Einteilung alle Ligen" Then
Sh.Range(Sh.Cells(5, 1), Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 10)) = ""
For i = 1 To 4
With Worksheets(i)
If Len(.Cells(3, 1)) Then
varQ = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 9).Value
Else
ReDim varQ(0)
End If
End With
If UBound(varQ) Then
With Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(varQ))
.Value = Worksheets(i).Name
.Offset(, 1).Resize(, UBound(varQ, 2)).Value = varQ
End With
End If
Next i
End If
End SubThomas