vba aus einer .xls alle tabellen zu einer machen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: vba aus einer .xls alle tabellen zu einer machen
von: Ruth
Geschrieben am: 06.05.2015 00:16:00

Hallo,
ich habe mein erstes Makro geschrieben.
Nun würde ich mich über Hilfe freuen, was ich besser machen kann.
-ich habe ein .xls(Nr1) mit unterschiedlich vielen Tabellen (der Dateiname ändert sich jeden Monat, die Tabellennamen jede Woche
-Aufgabe:aus einem weiteren .xls(Nr2) (mit Schaltfläche).xls(Nr1) erfragen, öffnen,
und alle Daten ab Zeile 3 in .xls(Nr2) kopieren.
-der Bereich mit dem einfügen, macht mir Probleme, es kostet soviele "Durchläufe" auf eine leere Zeile zu kommen, um alle Daten in eine Tabelle zu kopieren.
-wie kann ich einen schönen Abschluss finden. z.B. msgbox"es gibt keine weiteren Daten zum kopieren", die MsgBox krieg ich hin, aber woher weiss das Makro, dass nun schluss ist?
-kann ich bei der schleife mit den tabellen auch mit "worksheets.count" arbeiten? ist mir noch nicht gelungen, immer taucht ein fehler auf.
Vielen Dank
Ruth

Public Sub mdlChecklisteCopyPaste()
Dim awb As Workbook         'aktives worksheet - soll sich auf die Tabelle beziehen  / mit set  _
zugewiesen
Dim sheet1  As Worksheets
'Dim i As Integer            'Zähler für Tabellen-Durchlauf
Dim d As String             'dateiname für Tabelle                  'zugewiesen
Dim dn As String            'dateiname d+s                          'zugewiesen
Dim s As String             'variable für das zuzugreifende xls     'zugewiesen
Dim f As Integer            'Zähler für Schleife
Dim u As Integer            'zum durchzählen der Tabellen           'zugewiesen
    s = InputBox("Bitte geben Sie den Namen der Checkliste ein:", "Anfrage Checkliste", "2015  _
Januar.xls")
    'Fragebox um die richtige Tabelle aufzurufen
    Const pfad As String = ("C:\Users\Mummy\Documents\Test Check\")
    'Konstanter Pfad, um die Checkliste zu öffnen
    
    d = pfad
    dn = d & s                   'konstanter Pfad + variabeler Tabellenname
    
    ChDir "C:\Users\Mummy\Documents\Test Check\"                       'gehe zum pfad "d"
    Workbooks.Open Filename:=dn     'öffne das file mit dem namen: dn
    
    Set awb = ActiveWorkbook        'zuweisung variable awb zu der sich öffnenden Tabelle
    'Selection.AutoFilter            'ticke den autofilter an
    ActiveSheet.Rows("2").Copy      'ort: Tabelle / Zeile 2 / kopieren
    Windows("CheckLK.xlsm").Activate    'gehe zu dem xls sheet, in dem reinkopiert werden soll
    Sheets(2).Select
    Rows("1:1").Select                  'gehe zu Zeile 1
    ActiveSheet.Paste                   'füge die headline ein
 
    
    Application.CutCopyMode = False     'sorgt dafür, dass der KopierRahmen verschwindet
    
    awb.Activate                        'gehe zu dem worksheet, das dem namen awb zugewiesen  _
wurde
    
    'ActiveWorkbook.Worksheets.Count     'zählt die worksheets durch
    
    For u = 1 To 5 Step 1
        Sheets(u).Select                    'wähle sheet 1, dann zwei, dann 3 etc
        
        Range(Range("A3"), Range("A3").End(xlDown)).EntireRow.Select    'wähle zeile, nun nach  _
unten bis ende text
        Selection.Copy                                                  'kopiere das ausgewä _
hlte
        
        Windows("CheckLK.xlsm").Activate    'gehe zu dieser Seite
        Sheets(2).Select
        Range("a2").Select                  'wähle zeile A2
        
                For f = 1 To 5000                   'gehe von zeile zu zeile
                    If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Select Else Exit For
                                                    'falls zeile voll, gehe zur nächsten zeile
                Next f
                
        ActiveSheet.Paste                       'füge die werte ein
        
        Application.CutCopyMode = False         'sorgt dafür, dass der Kopierrahmen  _
verschwindet
        
        awb.Activate
    Next u
    
    Application.CutCopyMode = False
    
    
End Sub

Bild

Betrifft: AW: vba aus einer .xls alle tabellen zu einer machen
von: fcs
Geschrieben am: 06.05.2015 08:38:17
Hallo Ruth,
man muss hier noch konsequenter mit Objekt-Variablen arbeiten. dann kann man sich all die Activates und Select sparen.
Für die dateiauswahl sollte ein entsprechender Auswahl-Dialog angezeigt werden.
Gruß
Franz

Public Sub mdlChecklisteCopyPaste()
Dim wkbZiel As Workbook
Dim wksZiel As Worksheet
Dim ZeileZiel As Long
Dim awb As Workbook         'aktives worksheet - soll sich auf die Tabelle beziehen  / mit set  _
_
zugewiesen
Dim wksAwb  As Worksheet    'Tabellenblatt in Mappe awb
Dim ZeileL As Long
Dim dn As String            'dateiname d+s                          'zugewiesen
Dim u As Integer            'zum durchzählen der Tabellen           'zugewiesen
    'Konstanter Pfad, um die Checkliste zu öffnen
    Const pfad As String = ("C:\Users\Mummy\Documents\Test Check\")
    
    Set wkbZiel = ActiveWorkbook 'oder = Workbooks("CheckLK.xlsm")
    Set wksZiel = wkbZiel.Sheets(2) 'Zieltabelle in die kopiert werden soll
    
    'Dateiauswahldialog anzeigen
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "Bitte wählen Sie die Datei mit der Checkliste aus"
        .InitialFileName = pfad & "*.xls*"
        If .Show = -1 Then
            dn = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    
    Set awb = Workbooks.Open(Filename:=dn, ReadOnly:=True) 'öffne das file mit dem _
        namen: dnschreibgeschützt und zuweisung variable awb zu der sich öffnenden Tabelle
    
    'Selection.AutoFilter            'ticke den autofilter an
    'Titelzeile kopieren
    Set wksAwb = awb.Sheets(1)
    
    ZeileZiel = 1 'Einfügezeile für Titelzeile
    wksAwb.Rows("2").Copy Destination:=wksZiel.Rows(ZeileZiel) 'ort: Tabelle / Zeile 2 /  _
kopieren
         'nach zu Zeile 1 in Zieltabelle
    Application.CutCopyMode = False     'sorgt dafür, dass der KopierRahmen verschwindet
         
    ZeileZiel = ZeileZiel + 1 '1. Einfügezeile für Daten
    
    With awb
        'ActiveWorkbook.Worksheets.Count     'zählt die worksheets durch
        'Tabellenblätter in Mappe abarbeiten
        For u = 1 To .Worksheets.Count Step 1
        
            Set wksAwb = .Worksheets(u)       'wähle sheet 1, dann zwei, dann 3 etc
            
            With wksAwb
                ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Datenzeile
                If ZeileL >= 3 Then
                    'ab Zeile 3 kopieren
                    With .Range(.Rows(3), .Rows(ZeileL))
                        .Copy Destination:=wksZiel.Cells(ZeileZiel, 1)
                        'nächste Einfügezeile
                        ZeileZiel = ZeileZiel + .Rows.Count
                    End With
                End If
            End With
            Set wksAwb = Nothing
        Next u
            Application.CutCopyMode = False         'sorgt dafür, dass der Kopierrahmen _
    verschwindet
        
    End With
    Application.CutCopyMode = False
    
    'geöffnete Datei wieder schliessen
    awb.Close savechanges:=False
    
    wkbZiel.Activate
End Sub


Bild

Betrifft: AW: vba aus einer .xls alle tabellen zu einer machen
von: UweD
Geschrieben am: 06.05.2015 09:12:38
Hallo
so??
auf select und activate kann in den meisten Fällen verzichtet werden.

Public Sub mdlChecklisteCopyPaste()
    Dim awb As Workbook
    Dim s As String             'variable für das zuzugreifende xls     'zugewiesen
    Dim LR As Long              'erste freie Zielzeile
    Const pfad As String = ("C:\Users\Mummy\Documents\Test Check\")
    s = InputBox("Bitte geben Sie den Namen der Checkliste ein:", "Anfrage Checkliste", "2015  _
Januar.xls ")
    ChDir pfad
    Workbooks.Open Filename:=pfad & s
    Set awb = ActiveWorkbook
    With awb
        .ActiveSheet.Rows("2").Copy Workbooks("CheckLK.xlsm").Sheets(2).Rows("1:1")
        For u = 1 To .Worksheets.Count Step 1
            LR = Workbooks("CheckLK.xlsm").Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Sheets(u).Range(Range("A3"), Range("A3").SpecialCells(xlLastCell)).Copy _
                Workbooks("CheckLK.xlsm").Sheets(2).Cells(LR, 1)
        Next u
        .Close savechanges:=False
    End With
End Sub

Gruß UweD

 Bild

Beiträge aus den Excel-Beispielen zum Thema "vba aus einer .xls alle tabellen zu einer machen"