Inhalte aus Datein kopieren wenn

Hi,
ich sitze vor etwas kniffligem (für mich zumindest).
Ich habe eine Arbeitsmappe mit 1 Tabelle. In der 1. Zeile stehen Überschriften. Nun würde ich gerne per Makro (VBA) Inhalte aus verschiedenen Dateien in diese Tabelle (untereinander weg) kopieren, wenn 2 Inhalte bei diesen Tabellen stimmen. Beispiel: in der Quelldatei muss in Spalte "J" ein Ort auftauchen (meinetwegen Hamburg) und in "K" muss Inhalt = "JA" sein. Dann soll das Makro die kompletten Zeilen in denen BEIDE Kriterien enthalten sind, in meine Tabelle kopiert werden. Wenn die Tabelle beides nicht enthält, soll das Makro diese wieder schliessen und die nächste Tabelle aufrufen. Es handelt sich insgesamt täglich um 7 Tabellen die immer gleich heißen.
Öffnen schließen usw kriege ich wohl hin, aber wie kriege ich es hin, dass das Makro die Inhalte sucht und vor allem die dann NUR diese Zeilen untereinander weg in meine neue Tabelle kopiert ?
Bin für jede Idee sehr dankbar !

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Marcus,
das nachfolgende Makro (ungetestet) sollte es nach Anpassung der Namen etc. tun.
Gruß
Franz


Sub DatenHolen()
Dim arrFiles() As String, iFile As Integer
Dim wksZiel As Worksheet, ZeileZ As Long
Dim wbQuelle As Workbook, wksQuelle As Worksheet, ZeileQ As Long
Dim strOrt As String
strOrt = InputBox(Prompt:="Zu suchender Ort", _
Title:="Daten Holen - Suchbegriff Spalte J", _
Default:="Hamburg")
If strOrt = "" Then
'do nothing
Else
ReDim arrFiles(1 To 7)
'Namen der Dateien mit den Daten
arrFiles(1) = "C:\Users\Public\Test\01\File01.xlsx"
arrFiles(2) = "C:\Users\Public\Test\01\File02.xlsx"
arrFiles(3) = "C:\Users\Public\Test\01\File03.xlsx"
arrFiles(4) = "C:\Users\Public\Test\01\File04.xlsx"
arrFiles(5) = "C:\Users\Public\Test\01\File05.xlsx"
arrFiles(6) = "C:\Users\Public\Test\01\File06.xlsx"
arrFiles(7) = "C:\Users\Public\Test\01\File07.xlsx"
Application.ScreenUpdating = False
Set wksZiel = ActiveWorkbook.Worksheets("Tabelle1") 'oder = ActiveSheet 'Name ggf. anpassen
With wksZiel
'letzte Zeile mit Daten in Spalte J
ZeileZ = .Cells(.Rows.Count, 10).End(xlUp).Row
End With
strOrt = LCase(strOrt)  'Suchbegriff auf Kleinbuchstaben setzen
'Quelldateien abarbeiten
For iFile = LBound(arrFiles) To UBound(arrFiles)
'Quelldatei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=arrFiles(iFile), ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets(1) 'Index-Nr. oder Blattname ggf. anpassen
With wksQuelle
For ZeileQ = 1 To .Cells(.Rows.Count, 10).End(xlUp).Row
'Prüfen Spalte J (10) = Suchbegriff, SPalte K (11) ist gleich "ja"
If strOrt = LCase(.Cells(ZeileQ, 10)) And LCase(.Cells(ZeileQ, 11)) = "ja" Then
ZeileZ = ZeileZ + 1
'Zeile mit Formaten und Formeln/Werten kopieren
.Rows(ZeileQ).Copy Destination:=wksZiel.Cells(ZeileZ, 1)
'oder wenn nur Werte kopiert werden sollen
.Rows(ZeileQ).Copy
wksZiel.Cells(ZeileZ, 1).PasteSpecial Paste:=xlPasteValues
End If
Next ZeileQ
Application.CutCopyMode = False
End With
'Quelldatei wieder schliessen
wbQuelle.Close savechanges:=False
Next iFile
End If
Erase arrFiles
Set wbQuelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Inhalte aus Datein kopieren wenn

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread