Wert in 5 Dateien suchen und Zeile übertragen

Question

Hallo. Ich habe eine riesen Herausforderung in meinen Augen.

Also ich habe eine Masterdatei und 6 weitere Dateien, die sich aus der Masterdatei befüllen. Die Masterdatei enthält Bereichsnamen, diese sind einmalig (Bereich 1) und zudem 2 Zuständigkeiten. Einmal seitens des Betriebsrats (BR 1) und seitens der Personalabteilung (PB 1). Im ersten Schritt befüllen sich also die Dateien der Personalabteilung und jene des Betriebsrats. das Funktioniert einwandfrei. Da die Zuständigkeiten der Personalabteilung jedoch nicht immer mit den Zuständigkeiten des Betriebsrats übereinstimmen und regelmäßig wechseln brauche ich einen suchcode.

Ich muss für die Personalabteilungzuständigkeiten (PB1; PB" usw)) einen Suchcode entwickeln, der in allen Dateien des Betriebsrats (es sind jeweils separate Dateien) die einmalige Kennung "Bereich 1" gekoppelt mit der Zuordnung "PB1"; "PB2" usw. findet. da die Zuständigkeit im Betriebsrat auch wechseln kann, dann der "Bereich 1" den einen Monat bei "BR1" und den nächsten bei "BR2" stehen.
Wenn die Kennung gefunden wurde, DANN sollen die Spalten G-AD kopiert werden!

Kann mir jemand helfen oder zu ungenau?

Answer 1

hi all ^^

ein anfang vielleicht :-)

beliebig viele Dateien werden aus dem angegebenen pfad geoeffnet und die erste Tabelle durchsucht,bei fund erfolgt eine Kopie der angegebenen zellen
mit anschliessender beendigung des makros

gruss nighty

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String, Dsuche1 As String, Dsuche2 As String
Dim Dpfad As String, Dendung As String
Dim Suche As Range
Dim SuchZaehler As Long
Dim Schalter As Boolean
Dim ArrDat As Variant
Dsuche1 = "a" 'erster suchbegriff,witd in spalte a gesucht
Dsuche2 = "dd" ' zweiter suchbegriff in der fundzeile spalte c
Dpfad = "D:\T1\" 'dein pfad
Dendung = "*.xls" ' deine Endung
DateiName = Dir(Dpfad & Dendung)
Do While DateiName <> "" And Schalter = False
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=Dpfad & DateiName
SuchZaehler = 2
Do
'es folgt der suchbereich des ersten suchbegriffes
Set Suche = Worksheets(1).Range("A" & SuchZaehler & ":A" & Rows.Count).Find(Dsuche1)
If Not Suche Is Nothing Then
SuchZaehler = Suche.Row + 1
'es folgt die abfrage des zweiten suchbegriffes
If Dsuche2 = Cells(Suche.Row, 3) Then
ArrDat = Range("A" & Suche.Row & ":C" & Suche.Row) ' 'der zu kopierende Bereich A bis C zur zeit
ThisWorkbook.Worksheets(1).Range("D2:F2") = ArrDat ' einfuegen der Daten,D bis F zur zeit
Schalter = True
End If
Else
Exit Do
End If
Loop
Workbooks(DateiName).Close SaveChanges:=False
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Answer 2

<a href="atlanticbandfestival.com">poker</a> To practice patience, an enemy is the best teacher, When you lost your
attitude you lost everything

<a href="prisonersabroad.net">sbobet online</a> My pride fell with my fortunes, The empty tube makes the loudest
sound

Answer 3

hi all ^^

oder alle treffer

gruss nighty

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String, Dsuche1 As String, Dsuche2 As String
Dim Dpfad As String, Dendung As String
Dim Suche As Range
Dim SuchZaehler As Long, ZeilenIndex As Long
Dim ArrDat As Variant
Dsuche1 = "a" 'erster suchbegriff,witd in spalte a gesucht
Dsuche2 = "dd" ' zweiter suchbegriff in der fundzeile spalte c
Dpfad = "D:\T1\" 'dein pfad
Dendung = "*.xls" ' deine Endung
DateiName = Dir(Dpfad & Dendung)
ZeilenIndex = 2
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=Dpfad & DateiName
SuchZaehler = 2
Do
'es folgt der suchbereich des ersten suchbegriffes
Set Suche = Worksheets(1).Range("A" & SuchZaehler & ":A" & Rows.Count).Find(Dsuche1)
If Not Suche Is Nothing Then
SuchZaehler = Suche.Row + 1
'es folgt die abfrage des zweiten suchbegriffes
If Dsuche2 = Cells(Suche.Row, 3) Then
ArrDat = Range("A" & Suche.Row & ":C" & Suche.Row)
ZeilenIndex = ZeilenIndex + 1
ThisWorkbook.Worksheets(1).Range("D" & ZeilenIndex & ":F" & ZeilenIndex) = ArrDat

End If
Else
Exit Do
End If
Loop
Workbooks(DateiName).Close SaveChanges:=False
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub