Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema SpinButton
BildScreenshot zu SpinButton SpinButton-Seite mit Beispielarbeitsmappe aufrufen

Tabellen verschieben VBA

Betrifft: Tabellen verschieben VBA von: Mirko F.
Geschrieben am: 02.10.2020 10:39:19

Hallo,

ich habe eine Arbeitsmappe A von der ich ein Makro "Archivieren" starten möchte.
Zuvor wird in ein Array alle Blattnummer geschrieben, die ich in eine andere ausgewählte Arbeitsmappe (Archiv) verschieben möchte.

Dabei sollen die zu verschiebenden Tabellenblätter vor der Tabelle "Ende" in der Archivdatei verschoben werden.

Sub Archivieren()

Dim varDatei As Variant, avntLinks As Variant, vntLink As Variant
Dim wbALT As Workbook, wbNEU As Workbook
Dim n As Name
Dim iSheetZaehler, iAnzahlSheets, o As Integer
Dim iAuswahlSheets(510) As Integer
Dim sArchivSpalte, sBlattnummerSpalte As String
 
' Spalte in der Übersichtstabelle in der ausgewählt wird welche 
'Tabelle verschoben werden soll   
sArchivSpalte = "u"

 ' In der Spalte werden die Blattnummer in der Übersichtstabelle angezeigt.
sBlattnummerSpalte = "c" 

o = 1      'Startindex fürs Array
iAnzahlSheets = Sheets.Count  'Zählen alle Sheets in der Arbeitsmappe
           
    'Schreibe alle Blattnummern in das Array
    For a = 1 To iAnzahlSheets + 16 'Erste Zeile für 1 Tabelle ist 17
        If Cells(a, sArchivSpalte) = "Ja" Then
            iAuswahlSheets(o) = Cells(a, sBlattnummerSpalte)
            o = o + 1
        Else
        End If
    Next
      
'Set wbALT = ActiveWorkbook
    
'iAnzahlSheets = Sheets.Count
varDatei = Application.GetOpenFilename() 'Hole dir den Namen & Pfad der Archivdatei
    
If varDatei = False Then
    MsgBox "Der Benutzer hat abgebrochen.", vbInformation
    Exit Sub
Else
        
    Application.ScreenUpdating = False
        
    Set wbALT = ActiveWorkbook
    Set wbNEU = Workbooks.Open(varDatei)
        
    With wbALT
    
    For t = 1 To o

wbALT.Worksheets(iAuswahlSheets(t)).Move before:=Workbooks(wbNEU).Worksheets("Ende")
    
    Next
    End With
            
    'wbNeu.Close False
    
    End If

End Sub


Irgendwie peile ich den Umgang mit With und set usw nicht wirklich.
Hilfe wäre super, habe schon einige Zeit verschwendet :(.

Vielen Dank im Voraus.

Betrifft: AW: Tabellen verschieben VBA
von: Mirko F.
Geschrieben am: 02.10.2020 12:25:56

Niemand eine Idee :( ?!

Betrifft: AW: Tabellen verschieben VBA
von: peterk
Geschrieben am: 02.10.2020 12:38:40

Hallo

Was funktioniert an Deinem Makro nicht? (hab den Code noch nicht analysiert)

Peter

Betrifft: AW: Tabellen verschieben VBA
von: Mirko F.
Geschrieben am: 02.10.2020 12:59:33

Ja am Ende funktioniert nicht das Herzstück des codes nicht.
Das er aus dem aktuellen Workbook Tabellen in das ausgewählte Workbook verschiebt.

der Debugger kommt bei

Set wbALT = ActiveWorkbook
Set wbNEU = Workbooks.Open(varDatei)

With wbALT

For t = 1 To o
wbALT.Worksheets(iAuswahlSheets(t)).Move before:=Workbooks(wbNEU).Worksheets("Ende")
Next
End With

Betrifft: AW: Tabellen verschieben VBA
von: Mirko F.
Geschrieben am: 02.10.2020 13:07:18

Vlt liegt das an dem Array womit ich die Blattnummer übergebe "iAuswahlSheets(t)" ?

Betrifft: AW: Tabellen verschieben VBA
von: peterk
Geschrieben am: 02.10.2020 13:44:40

Hallo

So könnte es gehen

Option Explicit

Sub Archivieren()
   
    Dim varDatei As Variant
    Dim wsALT As Worksheet
    Dim wbALT As Workbook
    Dim wbNEU As Workbook
    
    Dim ltzZeileArchiv As Long
    
    Dim sArchivSpalte As String
    Dim sBlattnummerSpalte As String
    
    Dim i As Long
    
    'Spalte in der Übersichtstabelle in der ausgewählt wird welche
    'Tabelle verschoben werden soll
    sArchivSpalte = "U"
   
    'In der Spalte werden die Blattnummer in der Übersichtstabelle angezeigt.
    sBlattnummerSpalte = "C"
   
    ltzZeileArchiv = Cells(Rows.Count, sArchivSpalte).End(xlUp).Row

    varDatei = Application.GetOpenFilename() 'Hole dir den Namen & Pfad der Archivdatei
       
    If varDatei = False Then
        MsgBox "Der Benutzer hat abgebrochen.", vbInformation
        Exit Sub
    Else
           
        Application.ScreenUpdating = False
           
        Set wsALT = ActiveSheet
        Set wbALT = ActiveWorkbook
        Set wbNEU = Workbooks.Open(varDatei)
       
        For i = 1 To ltzZeileArchiv
            If wsALT.Cells(i, sArchivSpalte) = "Ja" Then
                wbALT.Worksheets(wsALT.Cells(i, sBlattnummerSpalte).Value).Move _
                    Before:=wbNEU.Worksheets("Ende")
            End If
        Next
       
    End If
   
End Sub



Schreib aber Bitte nicht die Blattnummer in Spalte 3, sondern den Blattnamen, da sich beim verschieben die Blattnummern ändern. z.B. Du willst Blatt 2,3,4 verschieben: nachdem Du Blatt 2 verschoben hast gibt es kein Blatt 4 mehr. Wenn Du mit Blattnummer arbeiten willst, müsstest Du die Schleife rückärts laufen lassen, bedingt aber das deine Spalte C sortiert ist.

Peter

Betrifft: AW: Tabellen verschieben VBA
von: Mirko F.
Geschrieben am: 02.10.2020 14:58:12

Hi Peter,
Top dein VBA code funzt !!!!
Ich habe versucht die Namen und die Links der zu kopierenden Sheets nicht zu überhmen bzw nicht mit rüber zukopieren.

Leider funktioniert das nicht mehr.
Sub Archivieren3()

Call ListSheetsBetweenStartEnd

Dim varDatei As Variant, avntLinks As Variant, vntLink As Variant


Dim n As Name
Dim iSheetZaehler, iAnzahlSheets, o As Integer
Dim iAuswahlSheets(510) As Integer
    
    Dim wsALT As Worksheet
    Dim wbALT As Workbook
    Dim wbNEU As Workbook
    
    Dim ltzZeileArchiv As Long
    
    Dim sArchivSpalte As String
    Dim sBlattnummerSpalte As String
    
    Dim i As Long
    
    'Spalte in der Übersichtstabelle in der ausgewählt wird welche
    'Tabelle verschoben werden soll
    sArchivSpalte = "U"
   
    'In der Spalte werden die Blattnummer in der Übersichtstabelle angezeigt.
    sBlattnummerSpalte = "C"
   
    ltzZeileArchiv = Cells(Rows.Count, sArchivSpalte).End(xlUp).Row 'Letzte belegte Zeile in  _
der Spalte ArchivSpalte "U" ermitteln

    varDatei = Application.GetOpenFilename() 'Hole dir den Namen & Pfad der Archivdatei
       
    If varDatei = False Then
        MsgBox "Der Benutzer hat abgebrochen.", vbInformation
        Exit Sub
    Else
           
        Application.ScreenUpdating = False
           
        Set wsALT = ActiveSheet
        Set wbALT = ActiveWorkbook
        Set wbNEU = Workbooks.Open(varDatei)
       
        For i = 1 To ltzZeileArchiv
            If wsALT.Cells(i, sArchivSpalte) = "Ja" Then
                wbALT.Worksheets(wsALT.Cells(i, sBlattnummerSpalte).Value + 2).Move _
                    Before:=wbNEU.Worksheets("Ende")
           
                        For Each n In ActiveSheet.Names ' Löschen der Namen in dem Workbook
                            n.Delete
                        Next
                        
                        avntLinks = ThisWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
                        
                        If IsArray(avntLinks) Then  ' Löschen der kopierten Links in dem  _
Workbook
                            
                            For Each vntLink In avntLinks
                                ThisWorkbook.BreakLink Name:=vntLink, Type:= _
xlLinkTypeExcelLinks
                            Next
                            
                        End If
                        
                        Application.ScreenUpdating = True

           End If
        Next
    End If
End Sub


Betrifft: AW: Tabellen verschieben VBA
von: Mirko F.
Geschrieben am: 05.10.2020 08:32:53

Hi Peter Danke, für deine Antwort. Das mit der Blattnummer werde ich hinbekommen.
Aber die o.g. Thematik ist leider nicht gelöst.

In meinem vba Text habe ich versucht die Links und die Namen nicht mitzukopieren,
bzw. die die schon vorhanden sind im Archiv zu verwenden.

VG