Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1272to1276
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Inhalte in neue Tabelle kopieren

Inhalte in neue Tabelle kopieren
Ivek
Hallo Leute, schon wieder ich, sorry!
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Inhalte in neue Tabelle kopieren
20.08.2012 16:54:39
Ivek
?
AW: Inhalte in neue Tabelle kopieren
21.08.2012 09:15:31
Ivek
Hallo Leute also hat hier auch keiner einer Idee, wie ich das umsetzen könnte!?
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige