Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.06.2024 19:56:24
17.06.2024 19:39:46
Anzeige
Archiv - Navigation
1520to1524
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
gefilterter Import
04.11.2016 11:27:20
Fred
Moin VBA-Experten,
es geht frisch in das Wochenende und für die kommenden Tage fehlt mir nur noch eine Lösung.
Ich habe zwei Arbeitsmappen
Eine Quellmappe namens „Stamm“ mit dem relevanten Tabellenblatt „Basis“ und meine ausgehende Mappe, mit derzeit zwei Tabellenblätter („Auswahl“ und „Daten“).
In Tabellenblatt „Auswahl“ steht in „A1“ die Überschrift „Liga“ und in „A2“ das Kürzel z.B. „D1“
Ich möchte nun per Button alle Datenzeilen aus Mappe „Stamm“/Blatt “Basis“, in meine ausgehende Mappe / Blatt „Daten“ importieren,- allerdings nur die Daten, welche mit dem Kürzel „D1“ identisch sind.
Meine Quellmappe „Stamm“, Tabellenblatt „Basis“ hat ebenfalls die SpaltenÜberschrift „Liga“, in denen sich die Kürzel befinden. (es ist die 1. Spalte)
Es soll also, vergleichbar eines erweiterten Filters, importiert werden.
Kann mir jemand das VBA schreiben oder mich auf einen Beispielcode bei Herber verweisen?
mfg
Fred

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

Betreff
Datum
Anwender
Anzeige
dan lade mal die 2 Beispielmappen hoch
04.11.2016 13:25:12
UweD
AW: dan lade mal die 2 Beispielmappen hoch
04.11.2016 16:02:43
UweD
Hallo Fred
hab mal was gebastelt
Sub Importieren()
    On Error GoTo Fehler
    Dim TBA, TBD, WB, TBB, Pfad$, Stammdatei$, i%
    Dim SP%, ZE&, LR&
    
    '*** Daten Anfang 
    Pfad = "C:\Temp\"
    Stammdatei = "Stamm.xlsm"
    
    Set TBA = ThisWorkbook.Sheets("Auswahl")
    Set TBD = ThisWorkbook.Sheets("Daten")
    Set WB = Workbooks.Open(Filename:=Pfad & Stammdatei)
    Set TBB = WB.Sheets("Basis")
    SP = 1 'Spalte A 
    ZE = 2 'ab Zeile 2 wegen Überschrift 
    '*** Stammdaten Ende 
    
    Application.ScreenUpdating = False
    LR = TBD.Cells(TBD.Rows.Count, SP).End(xlUp).Row
    TBD.Rows("2:" & LR).Delete xlUp ' reset 
        
    If TBB.AutoFilterMode Then TBB.AutoFilterMode = False ' Autofilter ausschalten 
    LR = TBB.Cells(TBB.Rows.Count, SP).End(xlUp).Row
        
    TBB.Range("$A1:$A" & LR).AutoFilter Field:=1, Criteria1:=TBA.Range("A2")
    TBB.Rows("2:" & LR).Copy TBD.Rows(2)
    WB.Close False
    
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: dan lade mal die 2 Beispielmappen hoch
04.11.2016 16:18:30
UweD
Noch eine Prüfung eingebaut, ob überhaupt Daten für den Filter da sind.
Sub Importieren()
    On Error GoTo Fehler
    Dim TBA, TBD, WB, TBB, Pfad$, Stammdatei$
    Dim SP%, ZE&, LR&, FFilter$
    
    '*** Daten Anfang 
    Pfad = "C:\Temp\"
    Stammdatei = "Stamm.xlsm"
    
    Set TBA = ThisWorkbook.Sheets("Auswahl")
    Set TBD = ThisWorkbook.Sheets("Daten")
    Set WB = Workbooks.Open(Filename:=Pfad & Stammdatei)
    Set TBB = WB.Sheets("Basis")
    SP = 1 'Spalte A 
    ZE = 2 'ab Zeile 2 wegen Überschrift 
    '*** Stammdaten Ende 
    
    FFilter = TBA.Range("A2")
    Application.ScreenUpdating = False
    LR = TBD.Cells(TBD.Rows.Count, SP).End(xlUp).Row
    TBD.Rows("2:" & LR).Delete xlUp ' reset 
        
    If TBB.AutoFilterMode Then TBB.AutoFilterMode = False ' Autofilter ausschalten 
    LR = TBB.Cells(TBB.Rows.Count, SP).End(xlUp).Row
        
    If WorksheetFunction.CountIf(TBB.Columns(SP), FFilter) > 0 Then
        TBB.Range("$A1:$A" & LR).AutoFilter Field:=1, Criteria1:=FFilter
        TBB.Rows("2:" & LR).Copy TBD.Rows(2)
    Else
        MsgBox "Für '" & FFilter & "' keine Daten gefunden"
    End If
    WB.Close False
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD
Anzeige
AW: dann lade mal die 2 Beispielmappen hoch
04.11.2016 16:53:04
Fred
Hallo Uwe,
ganz großer Sport mit den gefilterten Daten-Import als auch der vorherigen Prüfung!!
Erst dachte ich, Excel hängt sich wieder auf (es ging ums filtern von über 40.000 DS),- aber es funzt.
Du hast mir mit dem Script wirklich sehr geholfen.
Schönes Wochenende
mfg
Fred
Prima! Danke für die Rückmeldung.
05.11.2016 09:19:27
UweD

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige