Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.05.2024 19:56:55
Mit Schaltfläche (VBAMacro) zur aktuellen Woche springen
19.05.2024 19:42:43
zeilen löschen wenn
19.05.2024 17:55:54
Problem mit Formel countif
19.05.2024 17:28:17
E-Mailadressen Alphabetisch sortieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1916to1920
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1916to1920
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Importieren

Importieren
06.02.2023 15:34:07
Thomas
Hallo
Habe nochmal eine neuen Beitrag aufgemacht, da ich eine Beispieldatei gefunden habe, die allerdings nicht ganz passt.
Ich möchte die Tabellenblätter via Userform angezeigt, auswählen und ein ein Tabellenblatt untereinander importieren, am liebsten immer mit einer Leerzeile dazwischen.
Wäre im der Beispieldatei der Buuton " Import - Blattauswahl via Userform"
Ziel Tabellenblatt soll heißen "Daten"
Allerdings habe ich keine bis wenig VBA Kentnisse um den Code anzupassen.
Kann mir dazu jemand helfen?
Hier der Link zur Datei: https://www.herber.de/bbs/user/157667.xlsm
Vielen Dank
PS: Vielen Dank für die Hilfe aus den vorherigen Beitrag, Rudi Maintaire.

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Importieren
06.02.2023 17:36:48
Thomas
Ich verstehe nicht, wie ich nach der Auswahl der Blätter den Bereich vorgebe, zb .Range ("A1:B20")
Klicke ich mehrer Blätter an, soll immer der gleiche Bereich kopiert und eingefügt werden.
'#############  Auswahl der Tabellenblätter über Userform  ############
Sub importieren2()
Dim wbAlt As Workbook, wbNeu As Workbook
Dim wsAlt As Worksheet, wsNeu As Worksheet
Dim StatusCalc As Long
Dim arrSheets(), iSh, iK, sMsgText As String
Set wbNeu = ThisWorkbook
'Alte Version öffnen
ChDir (ThisWorkbook.Path)
With Application.FileDialog(msoFileDialogOpen)
    .Title = "Bitte Datei mit alten Versionsdaten öffen"
    .Filters.Clear
    .Filters.Add "Excel-Dateien", "*.xls;*.xlsm;*.xlsx),*.xls;*.xlsm;*.xlsx", 1
        If .Show = -1 Then
        'Alte Version schreibgeschütz öffnen
            Set wbAlt = Workbooks.Open(Filename:=.SelectedItems(1), ReadOnly:=True)
        Else
            GoTo Beenden
        End If
End With
 
    With UF_BlattAuswahl
        .lbxBlatt.Clear
        .Tag = ""
        For iSh = 1 To wbAlt.Worksheets.Count
            .lbxBlatt.AddItem wbAlt.Worksheets(iSh).Name
        Next
        .Show
        iSh = 0
        Select Case .Tag
        Case "Abbrechen"
            'kein Import
        Case "Auswahl"
            With .lbxBlatt
            For iK = 0 To .ListCount - 1
                If .Selected(iK) Then
                    iSh = iSh + 1
                    ReDim Preserve arrSheets(1 To iSh)
                    arrSheets(iSh) = .List(iK, 0)
                End If
            Next
            End With
        End Select
    End With
    Unload UF_BlattAuswahl
On Error GoTo Fehler
    
'Events und Berechnung speichern und deaktivieren - START
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    StatusCalc = .Calculation
    .Calculation = xlCalculationManual
End With
'Events und Berechnung speichern und deaktivieren - ENDE
    Set wbNeu = ThisWorkbook
    If iSh > 0 Then
        For iK = 1 To iSh
            'Importieren der alten Werte - START
            Set wsAlt = wbAlt.Worksheets(arrSheets(iK))
            Set wsNeu = wbNeu.Worksheets(arrSheets(iK))
            '...
            'Zellen importieren
            '...
        Next
    End If
wbAlt.Close savechanges:=False
Fehler:
    With Err
        Select Case .Number
            Case 0
                'alles OK
            Case 9
                MsgBox "Blatt """ & arrSheets(iK) & """ in Mappe """ & wbNeu.Name & """ nicht vorhanden!"
                Resume Next
            Case Else
                MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
        End Select
    End With
    
Beenden:
With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = StatusCalc
End With
End Sub

Anzeige
AW: Importieren
06.02.2023 18:45:01
Yal
Hallo Thomas,
"übernehmen" hilft nicht viel, wenn man nicht versteht, was da passiert. Und wenn zuviel auf einmal passiert, ist es schwieriger zu verstehen.
Fang zuerst mit folgenden Code für den UserForm (also Code in dem Codepane von Userform ablegen):
Private Sub cmbAbbrechen_Click()
    Unload Me
End Sub
Private Sub cmbAuswahl_Click()
Dim i
Dim Msg As String
    For i = 1 To lbxBlatt.ListCount
        If lbxBlatt.Selected(i) Then
            Msg = Msg & vbLf & lbxBlatt.List(i)
        End If
    Next
    MsgBox "Es sind folgende Blätter ausgewählt worden:" & Msg
    Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim W As Worksheets
    lbxBlatt.Clear
    For Each W In ThisWorkbook.Worksheets
        lbxBlatt.AddItem W.Name
    Next
End Sub
Probiere es und schau was passiert.
Dann ersetzst Du den CmdAuswahl_Click mit:
Private Sub cmbAuswahl_Click()
Dim i
    For i = 1 To lbxBlatt.ListCount
        If lbxBlatt.Selected(i) Then Daten_übertragen lbxBlatt.List(i)
    Next
    Unload Me
End Sub
und gleichzeitig in einem allgemeine Modul (Da wo Importieren liegt):
Sub Daten_übertragen(ByVal BlattName As String)
Dim wsQ As Worksheet 'Q wie Quelle
Dim wsZ As Worksheet 'Z wie Ziel
    Set wsQ = ThisWorkbook.Worksheets(BlattName)
    Set wsZ = ThisWorkbook.Worksheets("xyz")  'anpassen
    
    Range(wsQ.Range("A2"), wsQ.Cells(Rows.Count, "D").End(xlUp)).Copy wsZ.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 'Letzte Spalte "D" anpassen
End Sub

VG
Yal
Anzeige
AW: Importieren
07.02.2023 08:39:52
Thomas
Hallo Yal
Vielen Dank für Deine Hilfe.
Wenn ich das mache, bekomme ich immer Fehlermeldungen.
Was ich eigentlich möchte:
Excel auswählen, Tabellenblätter auflisten, Tabellennamen sind entweder text oder Zahl, die gewünschten anklicken und in ein Tabellenblatt einfügen.
Am liebsten Name Tabellenblatt, dann die Werte, eine Zeile frei, dann Name Tabellenblatt, dann die Werte, eine Zeile frei....
Leider habe ich ganz wenig VBA Kenntnisse, aber dieses würde mir meine Vereinsarbeit doch sehr erleichtern.
Gruß
Thomas
AW: Importieren
10.02.2023 13:00:57
Piet
Hallo Thomas
ich habe mir erlaubt den Code von Yal mal so umzuschreiben, das er bei mir funktioniert.
Und hoffe das er fehlerfrei arbeitet. Bitte gründlich testen. (E ist eine alte Excel 2003 Datei!)
Ich lösche die Tabelle1 aber vorher nicht, damit du immer weitere Daten anfügen kannst!
https://www.herber.de/bbs/user/157770.xls
mfg Piet
Anzeige
AW: Importieren
13.02.2023 14:26:10
Thomas
Hallo Piet
Vielen vielen Dank.
Funktioniert prima.
Gruß
Thomas
AW: geschlossen (keine AW)
12.02.2023 14:39:15
Piet
...

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige