Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1848to1852
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
Inhaltsverzeichnis

mehrere offene Arbeitsmappen durchsuchen

mehrere offene Arbeitsmappen durchsuchen
11.10.2021 11:00:31
Oliver
Hallo zusammen,
ich habe folgende Herausforderung:
Ich habe eine Zieldatei in der ich Inhalte aus offenen Salesforce Reports hineinkopieren will.
Jeder Salesforce Report hat einen eignen Reiter in der Vorlage.
Ich will nun alle offenen Salesforce Reports (csv) nach einem bestimmten Inhalt durchsuchen und den Inhalt in den dafür vorgesehenen Reiter kopieren.
In der Vorlage steht im Zielreiter in Zelle A3 jeweils der Suchinhalt für den Salesforce Report, Zelle A1 jeweils ab wo der Inhalt (ohne Kopfzeile) hineinkopiert werden soll.
Ich verzweifel wirklich an einer Lösungsfindung.
Danke für eure Hilfe!

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

Betreff
Datum
Anwender
Anzeige
AW: mehrere offene Arbeitsmappen durchsuchen
11.10.2021 11:53:08
Piet
Hallo
probiere bitte in einer Testdatei, NICHT im ORIGINAL, mal diesen Code aus. Er ist ungetestet, ich kann nicht garantieren das alles einwandfrei klappt!
Ich gehe davon aus das der Reitername im CSV File enthalten ist. Unklar ist mir ob nur die eine Zelle kopiert werden muss, oder mehrere Treffer sein können?
Das ist ein erster Versuch dir zu helfen, ggf. müsssen wir das Makro noch mal ändern. Viel Glück beim testen
mfg Piet
  • 
    Sub Offene_Dateien_durchsuchen()
    Dim i As Integer, j As Integer
    Dim rFind As Range, File As String
    Dim wbk As Workbook, n As Integer
    Dim SuchName As String, CopyAdr As String
    On Error GoTo Fehler
    With ThisWorkbook
    'alle Reiter in Zieltabellen durchsuchen
    For i = 1 To .Worksheets.Count
    'alle Offenen CSV nach Reiter durchsuchen
    For j = 1 To Windows.Count
    'CSV als Object und File ohne Dateiendung!
    Set wbk = Windows(j).Parent.Name
    File = Left(wbk.Name, Len(wbk.Name) - 4)
    'Reiter und Offene CSV Mappen vergleichen
    If InStr(.Worksheets(i).Name, File) Or _
    InStr(File, .Worksheets(i).Name) Then
    SuchName = .Worksheets(i).Range("A3").Value
    CopyAdr = .Worksheets(i).Range("A1").Value
    'Suchlauf in CSV Datei, Sheet1
    Set rFind = wbk.Sheets(1).Cells.Find(What:=SuchName, After:=[a1], _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlColumns, _
    SearchDirection:=xlNext, MatchCase:=False)
    'gefundennen Wert als Text kopieren
    If Not rFind Is Nothing Then
    .Worksheets(i).Range(CopyAdr) = rFind.Value
    n = n + 1
    End If
    End If
    Next j
    Next i
    End With
    MsgBox n & "  Dateien gefunden"
    Exit Sub
    Fehler:  MsgBox "unerwarteter Fehler aufgetreten!" & vbLf & Error()
    End Sub
    

  • Anzeige
    AW: mehrere offene Arbeitsmappen durchsuchen
    11.10.2021 12:10:38
    Oliver
    Hallo Piet,
    vielen lieben Dank für Deinen Support, Du bist ein großartiger Mensch!
    Ich glaube es übersteigt etwas meine VBA Kompetenzen und wir müssen es in der Vorlage Blatt für Blatt machen:
    Vorlage Blatt: SF_LTM
    Suchkriterium: Zelle A3
    wenn gefunden in offener CSV Datei, dann ab Zelle A5 einkopieren
    offene Quelle als CSV schliessen
    den Rest kreige ich dann adatiert.
    Danke für dein super Support!
    Oli
    AW: mehrere offene Arbeitsmappen durchsuchen
    11.10.2021 12:29:43
    Piet
    Hallo Oliver
    freut mich das ich helfen konnte, und wenn ihr es Blatt für Blatt für Blatt hinbekommt, kein Problem. Hauptsache es klappt.
    Wenn nicht melde dich bitte noch mal, für heute mache ich Schluss. Habe privat zu tun. Grüsse aus Ankara.
    mfg Piet
    Anzeige
    AW: mehrere offene Arbeitsmappen durchsuchen
    11.10.2021 12:32:15
    Oliver
    Hallo Piet,
    kannst du mir denn den Code nur für das Blatt und den Kriterien apdatieren?
    Ich bekomme es leider nicht hin :(
    AW: mehrere offene Arbeitsmappen durchsuchen
    11.10.2021 15:06:31
    Piet
    Hallo Oliver
    probier es bitte mal mit dieser Version. Für dich ist nur das sehr kurze Hauptprogramm wichtig. Dort kannst du mit VlgBlatt alle Blätter angeben.
    Der Befehl Go
    
    Sub dahinter ruft (nicht vergessen) ein Unterprogramm auf, das die Aufgabe abarbeitet.  Schau mal ob es so einwandfrei klappt?
    Ich kopiere nach Find=Okay ab Zelle A5 bis zum Ende der Spalte alles in den Reiter ab der Copy Adresse in Zelle A1. Und erhöhe die Copy Adresse in A1.
    mfg Piet
    
  • 
    Sub Offene_Dateien_durchsuchen_2()
    Dim rfind As Range, j, n, lz1 As Long
    Dim CopyAdr As String, Test As Variant
    Dim VlgBlatt As String, Suchtxt As String
    VlgBlatt = "SF_LTM":  Go
    
    
    Sub suchen    'Unterrprogramm zum Vorlageblatt suchen und bearbeiten
    VlgBlatt = "SF_xxx":  Go
    
    
    Sub suchen    '**  diese Prozedur kann beliebig oft aufgerufen werden!
    VlgBlatt = "SF_yyy":  Go
    
    
    Sub suchen    '**  Es setzt voraus das der Suchwert immer in Zelle A3 steht
    MsgBox n & "  CSV Dateien kopiert"
    Exit Sub
    suchen:   '***  Unterprogramm zum Vorlage Blatt bearbeiten  ***
    With ThisWorkbook
    On Error Resume Next
    Set Test = .Worksheets(VlgBlatt)
    If Err > 0 Then MsgBox VlgBlatt & "  dieses Vorlageblatt exisitiert nicht!": Return
    Test = Empty:  Err.Clear
    Suchtxt = .Worksheets(VlgBlatt).[a3]   'Zelle A3
    CopyAdr = .Worksheets(VlgBlatt).[a1]   'Zelle A1
    'alle Offenen Dateien nach Vorlage Blatt durchsuchen
    For j = 1 To Windows.Count
    If InStr(Windows(j).Caption, .Name) = 0 And _
    InStr(Workbooks(j).Name, VlgBlatt) Then Test = "Ok": Exit For
    Next j
    If Test = Empty Then MsgBox VlgBlatt & "  CSV Datei nicht gefunden!": Return
    'On Error GoTo Fehler
    'Suchwert in CSV Datei suchen
    Set rfind = Workbooks(j).Sheets(1).Columns(1).Find(What:=Suchtxt, _
    After:=[a1], LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:= _
    xlColumns, SearchDirection:=xlNext, MatchCase:=False)
    'gefundennen Wert als Text kopieren
    If Not rfind Is Nothing Then
    lz1 = Workbooks(j).Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    Workbooks(j).Sheets(1).Range("A5:A" & lz1).Copy
    .Worksheets(VlgBlatt).Range(CopyAdr).PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    'Neue Adresse in Vorlageblatt Zelle A1 schreiben
    lz1 = .Worksheets(VlgBlatt).Cells(Rows.Count, 1).End(xlUp).Row
    .Worksheets(VlgBlatt).Range("A1") = "A" & lz1 + 1
    n = n + 1   'Anzahl kopierter CSV Dateien
    'CSV Datei schliessen ohne speichern
    Workbooks(j).Close savechanges:=False
    End If
    Return
    End With
    Fehler:  MsgBox "unerwarteter Fehler aufgetreten!" & vbLf & Error()
    End Sub
    

  • Anzeige
    AW: mehrere offene Arbeitsmappen durchsuchen
    11.10.2021 13:23:30
    Oliver
    kann mir wer anders spontan hlefen?

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige