Microsoft Excel

Herbers Excel/VBA-Archiv

VBA Tabellenblatt erkennen und kopieren

Betrifft: VBA Tabellenblatt erkennen und kopieren von: Tanja
Geschrieben am: 06.10.2014 18:12:30

Hallo Zusammen,

für mich das erste Mal in einem Forum zu schreiben, normal lese ich immer nur und ich tue mein Bestes mein Problem richtig zu erklären ;-)

Ich habe eine Datei, deren erstes Tabellenblatt aus mehreren Hundert Zeilen besteht. Jede Zeile gehört zu einem bestimmten Teilkonzern von uns (z.B. FIM, FIT usw.). In Spalte L wird festgelegt zu welchem Teilkonzern die jeweilige Zeile gehört. Es gibt hierbei keine Reihenfolge. Also Zeile 5 kann zur FIM gehören und dann erst wieder Zeile 20.

Anschließend gibt es verschiedene Tabellenblätter - jedes nach einem Teilkonzern benannt. Ich möchte jetzt, dass das Makro im Haupttabellenblatt jede Zeile durchgeht und in das entsprechende Teilkonzern - Tabellenblatt kopiert.
Hierzu habe ich bisher folgendes Makro (bitte nicht wundern über evtl. Chaos, ich bin noch VBA Anfänger):

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


Funktioniert einwandfrei und macht was ich will. Aber wir haben viele verschiedene Teilkonzerne und so wie das Makro jetzt ist, müsste ich das ganze für jeden Teilkonzern separat anlegen.
Gibt es eine Möglichkeit dem Makro allgemeiner zu sagen: Schau dir Zeile 12 Spalte L an und kopiere diese Zeile in das Tabellenblatt was genauso heißt wie das was in Zeile 12 Spalte L steht? Sodass einmal geschrieben, es für alle Teilkonzerne funktioniert und auch, wenn neue dazu kommen?

Ich hoffe ihr könnt mir helfen und versteht was ich meine...
Viele Grüße

  

Betrifft: AW: VBA Tabellenblatt erkennen und kopieren von: Christian
Geschrieben am: 06.10.2014 19:51:39

hallo Tanja,
Voraussetzung:
- in Tab. "ConsDebts SE" beginnen die zu kopierenden Daten in Zeile 12
- in allen weiteren Tab. werden die Daten ab Zeile 22 eingefügt (vorhandene Daten werden überrschrieben)
- alle erfrdl. Tab. existieren (FIM, FIT usw.).
- es sind keine Filter gesetzt o.ä.

Dann teste mal den folgenden Code

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

Kommst du damit klar?
Gruß
Christian


  

Betrifft: AW: VBA Tabellenblatt erkennen und kopieren von: Ralph
Geschrieben am: 07.10.2014 01:03:14

Hallo Tanja,
damit gehst Du jede einzele Zeile durch und verschiebst das. Schneller ginge es, wenn Du Dir alle Zeilen zum jeweiligen Teilkonzern per Autofilter raussuchst und dann entsprechend den ganzen Block kopierst. Hier gibt es die Frage, ob Du insgesamt eine Kopfzeile hast oder nicht - ansonsten ungefähr so:

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
als Anfang. Wenn was nicht klar ist, melde Dich.
Gruß
Ralph


  

Betrifft: AW: VBA Tabellenblatt erkennen und kopieren von: Tanja
Geschrieben am: 07.10.2014 09:43:08

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?


  

Betrifft: AW: VBA Tabellenblatt erkennen und kopieren von: Ralph
Geschrieben am: 07.10.2014 13:58:16

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


  

Betrifft: AW: VBA Tabellenblatt erkennen und kopieren von: Tanja
Geschrieben am: 08.10.2014 09:17:20

Dankeschön Ralph!

Wenn ich

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

nach der Loop einbaue, schließt er mir die ganze Datei ohne zu speichern...
Dass das Hilfstabellenblatt nicht gelöscht wird, wär jetzt aber auch nicht sehr tragisch..


 

Beiträge aus den Excel-Beispielen zum Thema "VBA Tabellenblatt erkennen und kopieren"