hi johann :-)

bitte konkrete infos

welche zellen oder zeilen oder spalten der quelle sollen in welchen zellen spalten des zieles kopiert werden ?

von einer tabelle oder alle oder einzelne ?

gruss nighty

Hi nighty

erst vielen Dank für die schnelle Antwort

Ursprungsdatei-Registerblatt "Angebot" K12
Zieldatei- Registerblatt "AngebotAuflistung" I13

Ursprungsdatei-Registerblatt "Angebot" L12
Zieldatei- Registerblatt "AngebotAuflistung" J13

usw. die anderen quellen und ziele kann ich schon allein einfügen



gruss
Johann

hi Johann :-)

ein beispiel :-))

gruss nighty

Sub FilesListen()
Application.ScreenUpdating = False
Dim Dateien As Integer
Dim DateiName As String
With Application.FileSearch
.NewSearch
.LookIn = "D:\Temp\"
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
Workbooks(DateiName).Sheets("Angebot").Range("K12:L12").Copy ThisWorkbook.Sheets("AngebotAuflistung").Range("I13:J13")
Workbooks(DateiName).Close
End If
Next Dateien
End If
End With
Application.ScreenUpdating = True
End Sub

Hi nighty,

das Programm funktioniert supppppeeeerrrrr.
DANKE

Eine Frage:
Bei Ausführung dieses Befehls muss ich laufend die Schaltfläche Änderung Speichern JA/NEIN betätigen (ich habe in den Angebotsdateien Makros eingebaut)– kann man das ausschalten?
Die Daten sollen so abgespeichert werden :
z.B. Angebot 1 Zeile I und J 13, dann soll Excel „runter“ springen (Angebot 2) - I und J 14 usw. könntest Du es noch implementieren.

Muss man immer dieser Dateien aufmachen??

DANKE im Voraus

Gruss Johann

hi Johann :-)

wenn es sehr viele dateien sind weitere ereignisausschaltungen um den vorgang zu beschleunigen

gruss nighty

Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
With Application.FileSearch
.NewSearch
.LookIn = "D:\Temp\"
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
Workbooks(DateiName).Sheets("Angebot").Range("K12:L12").Copy ThisWorkbook.Sheets("AngebotAuflistung").Range("I13:J13")
Workbooks(DateiName).Close
End If
Next Dateien
End If
End With
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

Hi nighty

es funktioniert leider nicht.
Ich muss immer die Schaltfläche Änderung Speichern JA/NEIN betätigen um weiter zu kommen.
Die Daten sollen so abgespeichert werden :
z.B. Angebot 1 Zeile I und J 13, dann soll Excel „runter“ springen (Angebot 2) - I und J 14 usw. könntest Du es noch implementieren
Diese Auflistung soll untereinander gemacht werden.
Angebot 1 Name1(I13) PLZ 1 (J13)
Angebot 2 Name2 (I14) PLZ 2 (J14)
Angebot 3 Name3 (I15) PLZ 3 (J15) usw.

danke im Voraus

gruss Johann

hi Johann :-)

gruss nighty

bezieht sich auf auf die variable DateiNamen
Workbooks(DateiName).Close SaveChanges:=True

bezieht sich auf auf die Namen DateiNamen
Workbooks("DateiName").Close SaveChanges:=True

bezieht sich auf auf die datei wo das makro gestatet worden ist
ThisWorkbook.Close SaveChanges:=True

bezieht sich auf auf einen index
Workbooks(1).Close SaveChanges:=True

Hi nighty

es funktioniert SUPPEEERRRR.
Könntest Du noch diese automatische Funktion implementieren. Ich habe da keinen Schimmel:

Workbooks(DateiName).Sheets("Angebot").Range("K12:L12").Copy ThisWorkbook.Sheets("AngebotAuflistung").Range("I13:J13")

nächste Schlaufe
ThisWorkbook.Sheets("AngebotAuflistung").Range("I14:J14")
usw.

danke im Voraus

gruss Johann

hi Johann :-)

vielleicht so

gruss nighty

Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zaehler As Boolean
With Application.FileSearch
.NewSearch
.LookIn = "D:\Temp\"
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
If zaehler = False Then
zeile = 13
Else
zeile = ThisWorkbook.Sheets("AngebotAuflistung").Cells(Rows.Count, 9).End(xlUp).Row + 1
End If
Workbooks(DateiName).Sheets("Angebot").Range("K12:L12").Copy ThisWorkbook.Sheets("AngebotAuflistung").Range("I" & zeile & ":J" & zeile)
zaehler = True
Workbooks(DateiName).Close SaveChanges:=True
End If
Next Dateien
End If
End With
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

hi Johann :-)

es ist natürlich möglich geschlossene dateien auszulesen,doch der vorgang ist langsamer :(

stichwort excel4makro

gruss nighty

hi Johann :-)

da ich schusslig bin :-)) fehlt eine deklarierung

Dim zeile as long

bitte noch am anfang einfuegen :-)

gruss nighty

Danke

ich muss los in den Urlaub
noch ein mal

Vielen vielen
Dank