Sub Alle_xls_öffnen_und_kopieren()

Question

Hallo zusammen, ich habe ein Problem das der Code nicht das macht was er soll.......
Er überschreibt mir immer in der Zieldatei die schon vorhanden Zeilen und fügt die nicht unten an der ersten freien Zeile ein!! .
Kann mir da einer Helfen... Danke im voraus.

Answer 1

danke aber hab jetzt einen laufzeitfehler 1004.....

Answer 2

Hi MB100 :-)

Vielleicht ist die Sammeldatei im selben Ordner?
Sie wird nun ausgeschlossen!

Gruss Nighty

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim Dateipfad As String
Dateipfad = "P:\QM-MP\QM-MP\060_Q-After-Sales-Prozesse\03_AS-Checks\05_ASP- Check\Baureihe A205\16_Interne Verwendung QM\"
DateiName = Dir(Dateipfad & "*.xlsx")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=Dateipfad & DateiName
ActiveSheet.Range(Cells(6, 1), Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy _
ThisWorkbook.ActiveSheet.Cells(ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
Workbooks(DateiName).Close
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 3

moin moin,
leider funktioniert es nicht....... :(
Eine Datei wird geöffnet und bleibt offen und es wird die Fehlermeldung angezeigt 400!?

Answer 4

so,.... das hier würde funktionieren kopiert aber nur eine Zeile und zwar die Zeile6 ---< Das müsste einfach auf alle zeilen in denen in A oder b usw. etwas steht umgesetzt werden....


Sub Sammeln()

sQuellpfad = "P:\QM-MP\QM-MP\060_Q-After-Sales-Prozesse\03_AS-Checks\05_ASP- Check\Baureihe A205\16_Interne Verwendung QM\"
QZeile = 6 'Zeile in Quelldatei
QSpalten = 15 'Spaltenanzahl
QSpalteAb = "A" ' ab dieser Spalte insgesamt "QSpalten" Spaltenwerte übernehmen
ZZeile = 2 'erste Zeile in Zieldatei
ZSpalteAb = "A" 'erste Spalte in Zieldatei
Set wbGes = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
For Each oFile In fso.GetFolder(sQuellpfad).Files
If LCase(Right(oFile.Name, 5)) = ".xlsx" Then 'nur ".xlsx"-Dateien verarbeiten; bei ".xlsx" natürlich die letzten 5 Zeichen vergleichen
Application.Workbooks.Open oFile.Path 'Quelldatei öffnen
'Zellen lt Vorgabe aus Quelldatei lesen und in aktuelle Zeile der Zieldatei schreiben
wbGes.Worksheets(1).Cells(ZZeile, ZSpalteAb).Resize(1, QSpalten).Value = ActiveWorkbook.Worksheets(1).Cells(QZeile, QSpalteAb).Resize(1, QSpalten).Value
ActiveWorkbook.Close False 'Quelldatei schließen
ZZeile = ZZeile + 1 'Zeilennummer Zieldatei erhöhen
End If
Next
wbGes.Save 'Zieldatei speichern
End Sub

Answer 5

hi MB100 :-)

Mein Code war getestet!

Das ist genau die Zeile die bei meinem Code einen Fehler Produziert!
Die bei deinem Code(selbe Funktion,andere Syntx) geändert werden müßte!
So kann ich nichts nachvollziehen!
Du könntest noch jeweils 1 quell wie Zieldatei hochladen!
Dann wäre es leicht nachvollziehbar!

Gruß Nighty

Answer 6

hi MB100 :-)

Falls du sie hochladen solltest im xls Format bitte!
Andere Möglichkeit wäre den User zu bitten der den Code erstellt hat ,sie anzupassen!

Es heisst generell,sich einzuarbeiten und Dateien nachzubilden dauert immer länger als neu zu schreiben!

Gruss Nighty

Answer 7

Hi all ^^

Vielleicht noch für andere user die helfen möchten,hilfreich!
Die Syntax eines Bereiches für eine Copy
Range(Cells(y,x),Cells(y,x)).Copy ...
Wobei x wie y durch eine Synrax der letzten Zeile wie Spalte zu ersetzen wäre

Gruß Nighty