VBA Tabellenblatt erkennen und kopieren

Sub NachRechtsVerschiebenSE() Dim a As Long, i As Long a = 22 Application.ScreenUpdating = False For i = 12 To 10000 If Sheets("ConsDebts SE").Cells(i, 12).Value = "FIM" Then Sheets("ConsDebts SE").Select Range(Cells(i, 1), Cells(i, 7)).Copy Sheets("FIM").Select Rows(a).Select a = a + 1 ActiveSheet.Paste End If Next i Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub VerteilDat() Dim wksDst As Worksheet Dim strWks As String Dim i As Long, lngRw As Long With ThisWorkbook.Sheets("ConsDebts SE") For i = 12 To .Cells(.Rows.Count, 12).End(xlUp).Row strWks = .Cells(i, 12) Set wksDst = ThisWorkbook.Sheets(strWks) lngRw = wksDst.Cells(strWks.Rows.Count, 1).End(xlUp).Row + 1 If lngRw < 22 Then lngRw = 22 .Cells(i, 1).Resize(, 7).Copy wksDst.Cells(lngRw, 1) Next End With Set wksDst = Nothing End Sub

Sub Teilkonzern() Dim datenblatt As Worksheet Dim hilfsblatt As Worksheet Dim zell As Range 'Dateien setzen Set datenblatt = Sheets("ConsDebts SE") ' Zusatzblatt Set hilfsblatt = ActiveWorkbook.Sheets.Add datenblatt.Activate With datenblatt ' Aus Spalte L alle Teilkonzerne holen und in A1 vom Hilfsblatt stellen .Range(.Range("L12"), .Range("L12").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=hilfsblatt.Range( _ "A1"), unique:=True End With ' Dann Autofilter machen und das Ergebnis kopieren ' erst mal prüfen, ob autofilter an und ggf. ausmachen If datenblatt.AutoFilterMode Then datenblatt.AutoFilterMode = False End If Set zell = hilfsblatt.Range("A1") Do While Not IsEmpty(zell) ' Falls es das Blatt nicht gibt, anlegen On Error Resume Next Sheets(zell.Value).Select Debug.Print Err.Number If Err.Number = 9 Then ActiveWorkbook.Sheets.Add ActiveSheet.Name = zell End If On Error GoTo 0 ' Filter auf Spalte 12 (L) datenblatt.Range("A12").CurrentRegion.AutoFilter field:=12, Criteria1:=zell ' in das Teilkonzernblatt kopieren datenblatt.Range("A12").CurrentRegion.Resize(, 7).SpecialCells(xlCellTypeVisible).Copy _ Destination:=Sheets(zell.Value).Range("A23") Set zell = zell.Offset(1, 0) Loop End Sub

Tausend Dank schon mal für die Antworten!
@Christian: Wenn ich das genauso eingebe, wie du geschrieben hast, kommt eine Fehlermeldung "Fehler beim Kompilieren: Ungültiger Bezeichner"... Da ich nicht so fit bin in VBA kann ich leider nicht nachvollziehen, woher der Fehler kommt.
@Ralph: Super - das funktioniert schon mal nicht schlecht, danke! Ein paar Kleinigkeiten, die ich noch verändern will (das Hilfsblatt soll noch gelöscht werden und aus dem Blatt ConsDebts SE soll der Filter am Ende wieder rausgenommen werden), aber das krieg ich bestimmt auch allein hin.
Eine Sache aber noch, bei der ich nicht genau weiß, wie ich das löse: Im Moment kopiert er nicht nur die entsprechende Zeile sondern auch einmal die Kopfzeile mit (auf dem ConsDebts SE Sheet ist das Zeile 11). Lässt sich das vielleicht noch vermeiden?

Hallo Tanja,
ich hatte ja geschrieben, daß man das noch anpassen muß und das Hilfsblatt löschen habe ich echt vergessen:

 ' hilfsblatt löschen
Workbooks(hilfsblatt.Parent.Name).Close False

nach der Loop einbauen.
Für das Kopieren:

 ' in das Teilkonzernblatt kopieren
With datenblatt.Range("A12").CurrentRegion.Resize(, 7)
Range(.Rows(2), .Rows.Count).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets( _
zell.Value).Range("A23")
End With

Mit dem Range(.Rows(2), .Rows.Count) lasse ich die erste Zeile aus dem Bereich weg.
Die Zielzelle A23 ist ok? Ansonsten halt anpassen.
Für ein "richtig sauberes" Makro fehlen noch zum Beispiel:
- Löschen der Daten in den Teilkonzern-Blättern (wenn im Autofilter weniger Zeilen sind als schon gefüllt waren. Das würde ich nach dem Kopieren der Teilkonzerne ins Hilfsblatt einbauen. Dann kannst Du nämlich noch mal eine Schleife über die Werte machen und einfach in jedem Blatt alles ab Zeile 22 löschen.
Falls Du Dich über die ev. kurzen Schreibweisen wunderst:

Sheets("ConsDebts SE").Select
Range(Cells(i, 1), Cells(i, 7)).Copy

hat für die Kopie den gleichen Effekt wie:

Sheets("ConsDebts SE").Range(Cells(i, 1), Cells(i, 7)).Copy

Ansonsten nicht, weil im oberen Code dann das Blatt ConsDebs SE aktiv ist, was beim letzteren nicht der Fall ist - da hast Du einfach nur den Bereich von dort kopiert.
Gruß
Ralph

Beliebteste Forumthreads (12 Monate)

VBA Tabellenblatt erkennen und kopieren

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

321 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Tabellenblatt erkennen und kopieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

321 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread