Office: Bereich aus geschlossener Datei auslesen VBA

Helfe beim Thema Bereich aus geschlossener Datei auslesen VBA in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, ich möchte bereiche aus geschlossener Datei Auslesen und ins aktuellen Blatt übernehmen. Beispiel Codes dazu habe ich einige gefunden nur keine... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Aksa, 25. Februar 2023.

  1. Aksa Neuer User

    Bereich aus geschlossener Datei auslesen VBA


    Hallo,

    ich möchte bereiche aus geschlossener Datei Auslesen und ins aktuellen Blatt übernehmen.
    Beispiel Codes dazu habe ich einige gefunden nur keine passende zu meinem Problem.
    Die geschlossene Datei hat 14 Spalten und über 700 Zeilen. Ich würde gerne mein gesuchten Wert über die InputBox eingeben (muß nicht) und danach suchen. Gesucht werden soll in der Spalte E. Bei einem Treffer in der Spalte E sollen dann auch die Spaltenwerte von A,B,C,D,F,K,L,M mit übernommen werden. Problem dabei ist, der gesuchte Wert kann in Spalte E mehrmals vorkommen, wenn ja soll er auch diese mit übernehmen. Leider habe ich dazu kein passenden Beispielcode finden können.
    Der Einzige Code wo bedingt meine Anfrage lösen kann ist:
    Code:
    Sub ImportDatafromcloseworkbook()
    'Updateby Extendoffice
    Dim xWb As Workbook
    Dim xAddWb As Workbook
    Dim xRng1 As Range
    Dim xRng2 As Range
    Set xWb = Application.ActiveWorkbook
    xTitleId = "KutoolsforExcel"
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Application.Workbooks.Open .SelectedItems(1)
            Set xAddWb = Application.ActiveWorkbook
            Set xRng1 = Application.InputBox(prompt:="Select source range", Title:=xTitleId, Default:="A1", Type:=8)
            xWb.Activate
            Set xRng2 = Application.InputBox(prompt:="Select destination cell", Title:=xTitleId, Default:="A1", Type:=8)
            xRng1.Copy xRng2
            xRng2.CurrentRegion.EntireColumn.AutoFit
            xAddWb.Close False
        End If
    End With
    End Sub
    ich kann meine mehrfach treffer hier auswählen,nur muß ich die erst finden bei über 700 Zeilen.


    Danke & Grüße
     
  2. Beverly
    Beverly Erfahrener User
    Hi,

    eine Mehrfachsuche realisiert man z.B. nach diesem Prinzip:

    Code:
    Sub Mehrfachsuche()
        Dim rngSuche As Range
        Dim strStart As String
        Dim strSuche As String
        strSuche = "MeinBegriff"  '<== hier dein Code zur Auswahl des Suchbegriffs
        With Worksheets("Tabelle1").Columns(5)
            Set rngSuche = .Find(strSuche, lookat:=xlWhole)
            If Not rngSuche Is Nothing Then
                strStart = rngSuche.Address
                Do
                    MsgBox rngSuche.Address  '<== hier müsste dann dein Code stehen, was mit den Daten aus der gefundenen Zeile gemacht werden soll
                    Set rngSuche = .FindNext(rngSuche)
                Loop While rngSuche.Address <> strStart
            End If
        End With
    End Sub
    


    Bereich aus geschlossener Datei auslesen VBA GrußformelBereich aus geschlossener Datei auslesen VBA Beverly's Excel - Inn
     
    Beverly, 25. Februar 2023
    #2
  3. Aksa Neuer User
    @Beverly: Danke, ich habe Suche/Auflistung jetzt ohne VBA gelöst. Für die Übertragung habe ich ein anderes Code gefunden und soweit angepasst.
    Code:
    Sub BemusterungsAuftragSpeichern()
    Dim wbQuelle As Workbook, wksQuelle As Worksheet
    Dim wbZiel As Workbook, wksZiel As Worksheet
    Dim strZiel As String, strPfadZiel As String
    Dim bolOpen As Boolean
    Dim Zeile_Z As Long, Zelle_Letzte As Range
    
    If MsgBox("Bemusterungsauftrag jetzt speichern?", vbQuestion + vbOKCancel, _
    "Speichern Bemusterungsauftrag") = vbCancel Then GoTo Fehler
    On Error GoTo Fehler
    Set wbQuelle = ActiveWorkbook 'Datei "Laufkarte_zur_Auftragsabwicklung.xlsm"
    Set wksQuelle = wbQuelle.Worksheets("Eingabe")
    Application.ScreenUpdating = False
    strPfadZiel = "C:\Muster"       '### anpassen ##!!!
    strPfadZiel = wbQuelle.Path                'wenn beide Dateien im gleichen Verzeichnis
    strZiel = "daten.xlsx"
    If fncCheckWorkbookOpen(strZiel) Then
    Set wbZiel = Application.Workbooks(strZiel)
    bolOpen = True
    Else
    Set wbZiel = Application.Workbooks.Open(strPfadZiel & Application.PathSeparator _
    & strZiel)
    bolOpen = False
    End If
    Set wksZiel = wbZiel.Worksheets("Daten L1")
    With wksZiel
    'nächste Einfüge-Zeile ermitteln
    Set Zelle_Letzte = .Cells.Find(What:="*", After:=Range("A1"), _
    LookIn:=xlFormulas, lookat:=xlWhole, searchorder:=xlByRows, _
    searchdirection:=xlPrevious)
    If Zelle_Letzte Is Nothing Then
    Zeile_Z = 1
    Else
    Zeile_Z = Zelle_Letzte.Row + 1
    End If
    'Zellinhalte übertragen - nur Werte
    wksQuelle.Range("D6").Copy
    .Cells(Zeile_Z, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    wksQuelle.Range("F6").Copy
    .Cells(Zeile_Z, 5).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    wksQuelle.Range("H6").Copy
    .Cells(Zeile_Z, 9).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    wksQuelle.Range("J6").Copy
    .Cells(Zeile_Z, 12).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    wksQuelle.Range("L6").Copy
    .Cells(Zeile_Z, 15).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    wksQuelle.Range("N6").Copy
    .Cells(Zeile_Z, 19).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End With
    Application.CutCopyMode = False
    If bolOpen = False Then
    wbZiel.Close savechanges:=True
    End If
    Fehler:
    Application.ScreenUpdating = True
    With Err
    Select Case .Number
    Case 0 'Alles OK
    Case Else
    MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
    End Select
    End With
    Set wbZiel = Nothing: Set wksZiel = Nothing: Set Zelle_Letzte = Nothing
    Set wbQuelle = Nothing: Set wksQuelle = Nothing
    End Sub
    Public Function fncCheckWorkbookOpen(ByVal strName As String) As Boolean
    'Prüft ob Arbeitsmappe geöffnet ist
    Dim wb As Workbook
    On Error GoTo Fehler
    fncCheckWorkbookOpen = True
    Set wb = Application.Workbooks(strName)
    Fehler:
    With Err
    Select Case .Number
    Case 0 'Alles ok
    Case Else
    fncCheckWorkbookOpen = False
    End Select
    End With
    End Function
    Der Code funktioniert so weit ganz gut, hat aber auch seine Einschränkungen.
    Bei "'Zellinhalte übertragen - nur Werte" wollte ich die Zelleninhallte von
    D7:N7
    D8:N8
    D9:N9
    D10:N10 mit übernehmen aber er kopiert immer nur die ersten von D6:N7 in die Zieldatei.
    Wie kann ich dieses Problem lösen ?

    Danke & Grüße
     
Thema:

Bereich aus geschlossener Datei auslesen VBA

Die Seite wird geladen...
  1. Bereich aus geschlossener Datei auslesen VBA - Similar Threads - Bereich geschlossener Datei

  2. Reihe von Datum in Bereiche einteilen

    in Microsoft Excel Hilfe
    Reihe von Datum in Bereiche einteilen: Hi, ich habe ein Problem beim Erstellen von Datumsbereichen aus einer großen Liste. Sprich ich habe eine lange Liste untereinander stehender Daten und ich möchte daraus die zusammenhängenden...
  3. VBA verschiedene definierte "nicht leere" Bereiche aus Datei kopieren in neue Datei

    in Microsoft Excel Hilfe
    VBA verschiedene definierte "nicht leere" Bereiche aus Datei kopieren in neue Datei: Hallo zusammen, nachdem ich jetzt vieles hin- und her versucht habe komme ich nicht wirklich zu einem Ergebnis das ich gerne hätte. Ich habe einen Ordner in dem mehrere Excel Dateien...
  4. Zählenwenns mit Datum als Kriterium

    in Microsoft Excel Hilfe
    Zählenwenns mit Datum als Kriterium: Hallo zusammen, Ich bekomme es leider nicht hin das zu erreichen was ich gerne hätte. Ich möchte in einem 2. Tabellenblatt gerne das 1. Tabellenblatt(Auftragstabelle 2023)in Form einer Tabelle mit...
  5. Excel Zellenwert aus vorgegebenen Bereich ohne Wiederholung wiedergeben

    in Microsoft Excel Hilfe
    Excel Zellenwert aus vorgegebenen Bereich ohne Wiederholung wiedergeben: Guten Tag, ich bin derzeit dabei mir ein Tabellenblatt aufzubauen, wo ich anhand von Fußballergebnissen mir ein simples Auslosungstool anhand einfacher Formeln baue. Nun bin ich aber beim...
  6. Summenprodukt mit ODER-Bedingung bei einem Bereich

    in Microsoft Excel Hilfe
    Summenprodukt mit ODER-Bedingung bei einem Bereich: Hallo zusammen, ich nutze die SUMMENPRODUKT-Formel häufig, um aus Listen die verschiedenen Ausprägungen miteinander zu kombinieren und den dazugehörigen Wert auszulesen. Soweit, so gut und...
  7. Summe über dynamischen Bereich

    in Microsoft Excel Hilfe
    Summe über dynamischen Bereich: Hallo Leute, wie kann man die Summe für mehrere Zeilen in einer bestimmten Spalte berechnen ? zB Kritieren sind: Produkt: A , Name: AK, von: 042022 und für Spalte: 1 Ich habe versucht mit...
  8. Zeile in Bereich mit Datum füllen

    in Microsoft Excel Hilfe
    Zeile in Bereich mit Datum füllen: Hallo Zusammen, bin neu hier und mein Name ist Ulrich. Von Excel habe ich wenig Ahnung . Daher hier mein Problem. Ich habe eine Excel Datei in der in Spalte B mit einem Dropdown Namen ausgewählt...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden