Ich hab wirklich keine Idee wie ich das umsetzen kann.
Habe folgenden Code beim CommandClick_():
Private Sub cmdRegisterErstellen_Click()
Call fktRegisterAnlagePruefen(ActiveWorkbook.Worksheets("ET"))
End Sub
damit wir dir dann dieser Code ausgeführt:Public Sub fktRegisterAnlagePruefen(wks As Worksheet)
Dim vks As Worksheet
Dim wsNew As Worksheet
Dim intSpalteStandardVerz As Integer
Dim intAllgZeilenBeginn As Integer
Dim xlEnd As Integer
Dim strZellenWert As String
Dim strTabNameAusStandardVerz As String
Dim intDummy As Integer
Dim intPosBackslash As Integer
Dim intBackslashZaehler As Integer
Dim intAnzMappen As Integer
Dim bolRegisterAnlegen As Boolean
Dim i As Integer
Dim j As Integer
With wks
intSpalteStandardVerz = 6
intAllgZeilenBeginn = 4
xlEnd = .Cells(.Rows.Count, intSpalteStandardVerz).End(xlUp).Row
For i = intAllgZeilenBeginn To xlEnd
strZellenWert = .Cells(i, intSpalteStandardVerz).Value
intPosBackslash = 0
intBackslashZaehler = 1
Do
intDummy = InStr(intBackslashZaehler, strZellenWert, "\")
If intDummy 0 Then intPosBackslash = intDummy
intBackslashZaehler = intDummy + 1
Loop Until intDummy = 0
strTabNameAusStandardVerz = Right(strZellenWert, Len(strZellenWert) - intPosBackslash)
intAnzMappen = ActiveWorkbook.Worksheets.Count
bolRegisterAnlegen = False
For j = 1 To intAnzMappen
Set vks = ActiveWorkbook.Worksheets(j)
If vks.Name = strTabNameAusStandardVerz Then
bolRegisterAnlegen = True
End If
Next j
If bolRegisterAnlegen = False Then
Set wsNew = fktRegisterNeuAnlegen(strTabNameAusStandardVerz)
Call fktRegisterKopfdatenAnlegen(wsNew, strTabNameAusStandardVerz)
End If
Next i
End With
End Sub
Private Function fktRegisterNeuAnlegen(strRegisterName As String) As Worksheet
Dim wsNew As Worksheet
Dim i As Integer
Set wsNew = Worksheets.Add
With wsNew
.Name = strRegisterName
.Move after:=Sheets(Sheets.Count)
End With
Set fktRegisterNeuAnlegen = wsNew
Set wsNew = Nothing
End Function
Private Sub fktRegisterKopfdatenAnlegen(wsNew As Worksheet, strTabNameAusStandardVerz As String) _
Dim strZellenwertAusET As String
Dim xlEnd As Integer
Dim i As Integer
With wsNew
'Überschrift
strZellenwertAusET = ActiveWorkbook.Worksheets("ET").Cells(1, 1).Value
.Cells(1, 1).Value = strZellenwertAusET
'Gelb und so
.Range(.Cells(1, 1), .Cells(1, 6)).Font.Bold = True
.Range(.Cells(1, 1), .Cells(1, 6)).Font.Size = 20
.Range(.Cells(1, 1), .Cells(1, 6)).Font.Italic = True
.Range(.Cells(1, 1), .Cells(1, 6)).Interior.ColorIndex = 36
.Range(.Cells(1, 1), .Cells(1, 6)).MergeCells = True
.Range(.Cells(1, 1), .Cells(1, 6)).HorizontalAlignment = xlCenter
.Range(.Cells(1, 1), .Cells(1, 6)).VerticalAlignment = xlCenter
.Range(.Cells(1, 1), .Cells(1, 6)).BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin
'Überschrift 2. Zeile
.Cells(2, 1).Value = strTabNameAusStandardVerz
.Range(.Cells(2, 1), .Cells(2, 6)).Font.Bold = True
.Range(.Cells(2, 1), .Cells(2, 6)).Font.Size = 14
.Range(.Cells(2, 1), .Cells(2, 6)).Font.Italic = False
.Range(.Cells(2, 1), .Cells(2, 6)).Interior.ColorIndex = 36
.Range(.Cells(2, 1), .Cells(2, 6)).MergeCells = True
.Range(.Cells(2, 1), .Cells(2, 6)).HorizontalAlignment = xlCenter
.Range(.Cells(2, 1), .Cells(2, 6)).VerticalAlignment = xlCenter
.Range(.Cells(2, 1), .Cells(2, 6)).BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin
'Spaltenbezeichnungen
'1. Spalte
For i = 1 To 6
strZellenwertAusET = ActiveWorkbook.Worksheets("ET").Cells(3, i).Value
.Cells(3, i).Value = strZellenwertAusET
Select Case i
Case 1
.Columns(i).ColumnWidth = 50
Case 2
.Columns(i).ColumnWidth = 17
Case 3
.Columns(i).ColumnWidth = 20
Case 4
.Columns(i).ColumnWidth = 18
Case 5
.Columns(i).ColumnWidth = 8
Case 6
.Columns(i).ColumnWidth = 25
End Select
.Range(.Cells(3, i), .Cells(3, 6)).Font.Bold = True
.Range(.Cells(3, i), .Cells(3, 6)).Font.Size = 12
.Range(.Cells(3, i), .Cells(3, 6)).Font.Italic = False
.Range(.Cells(3, i), .Cells(3, 6)).Interior.ColorIndex = 15
'.Range(.Cells(3, i), .Cells(3, 6)).MergeCells = False
.Range(.Cells(3, i), .Cells(3, 6)).HorizontalAlignment = xlCenter
.Range(.Cells(3, i), .Cells(3, 6)).VerticalAlignment = xlCenter
.Range(.Cells(3, i), .Cells(3, 6)).BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin
Next i
End With
End Sub
Bis hierher funktioniert alles hervorragend.
Nun mein Problem:
Ich will das per cmdRegisterErstellen_Click() neben der neuen Tabelle die erstellt wird auch die Zellen mit den jeweiligen Inhalten kopiert und in der neuen Tabelle eingefügt werden. Ich kriegs nicht hin, und bin auch ganz neu in dem Gebiet. Hab keine Idee wie ich es umsetzen könnte.
Bevor die neue Tabelle erstellt wird, prüft mein Programm ob die Tabelle bereits vorhanden ist, indem die Tabelle "ET" durchsucht wird. Wenn dies nicht der Fall ist, also ein neues Teil in "ET" auftaucht, wird demenstsprechend eine neue Tabelle erstellt und dieses neue Teil aus ET soll direkt da reinkopiert werden.
Soviel zur Theorie, nur hab ich keinen Blassen wie ich das umsetzen soll! Bin total neu in diesem Gebiet. Wahrscheinlich ist es was ganz einfaches, aber wie gesagt komm nicht drauf.
Bitte um Hilfe! ^^
Danke schon mal!
Grüße