Daten aus anderen Dateien Kopieren ohne Erfolg
Marco
da hier immer gut geholfen wird, möchte ich euch auch um Hilfe bitten - ich verzweifle schon fast :-(
Muss aus einer xls-Datei (Cockpit) eine 2. Datei öffnen, in die Daten eingelesen werden, und zwar aus einer 3. Datei. Diese wird vorher gefiltert und nur Daten aus einer Spalte sollen übertragen werden.
Habe ein Makro soweit geschrieben, dass die entsprechenden Dateien geöffnet werden. Nur leider verliert Excel beim Kopieren die Daten und überträgt diese nicht. Habe schon verschiedene Ansätze ausprobiert - ohne Erfolg :-(
Ist wahrscheinlich nur eine Kleinigkeit - aber irgendwo hakts da bei mir.
Vielen Dank schonmal für eure Hilfe!
Hoffe, ihr könnt mir helfen. Hier mal mein Code:
__________________________________________________
Option Explicit
Sub Rohdaten_holen()
Dim b, i, z, s, t, n, f, zeilebaureihe, aktuelleKW As Integer
Dim Zieldatei, Baureihe, DateiI, DateiII, Fehlerbericht, Datei, Pfad As String
Sheets("Bericht").Select
DateiI = Cells(27, 59) 'Dateiname inkl. Pfad
On Error Resume Next
'Datei wird geöffnet und vorgefiltert
Workbooks.Open Filename:=DateiI
Sheets(1).Select
For i = 1 To 15
If Cells(1, i) = "Problemstatus" Then
ActiveSheet.Range("$A$1:$R$2500").AutoFilter Field:=i, Criteria1:=Array("1", "2", "3", " _
4", "="), Operator:=xlFilterValues
GoTo RIP:
End If
Next i
RIP:
'Kopieren funktioniert noch
Columns(1).Copy
Application.CutCopyMode = True
ActiveWorkbook.Close
'neue Datei öffnen.
Workbooks("Fehlerbericht.xls").Activate
zeilebaureihe = Sheets("Hidden").Range("I8") + 1
Baureihe = Sheets("hidden").Range("L" & zeilebaureihe)
Fehlerbericht = Sheets("hidden").Range("M" & zeilebaureihe)
Datei = "\Fehlerbericht_" & Baureihe & ".xls"
Zieldatei = Fehlerbericht & Datei
Workbooks.Open Filename:=Zieldatei
Workbooks(DateiI).Activate
Sheets(1).Columns("A").Copy
'ab hier Problem, dass die Daten nicht reinkopiert werden. Was ist daran falsch? Zelle A1 _
wird mit KW benamt.
'Lasse ich die Application.Cutcopy weg, dann ist in der Zieldatei Spalte A ausgewählt....
Windows("Fehlerbericht_" & Baureihe & ".xls").Sheets("Zu_Ab_Rohdaten").Range("A1"). _
PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Cells(1, 1) = "KW " & aktuelleKW
End Sub
Anzeige