Daten in externe Excel-Datei schreiben
11.02.2016 14:59:46
Lutz
mein folgender Code funktioniert einwandfrei.
Folgende Frage ergibt sich für mich allerdings:
Welchen Teil müsste ich anpassen wenn ich folgendes ändern möchte:
Bisher schreibt er die Daten in einen neuen Reiter in der gleichen Datei.
NEU: ich würde gerne in EINE Datei - in einem Unterordner schreiben
Vielen Dank wie immer für die Hilfe.
Lutz
Sub Schichtbericht_Neu_Erfassung_Schicht1()
Dim wksEingabe As Worksheet
Dim wksListe As Worksheet
Dim lngZeile As Long, rngZelle As Range
Set wksEingabe = Worksheets("Schichtbericht_Schicht1") 'Eingabetabellenblatt
Set wksListe = Worksheets("Auswertung") 'Tabellenblatt in das die Daten geschrieben _
werden _
sollen
With wksListe
'nächste freie Zeile in Liste
Set rngZelle = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If rngZelle Is Nothing Then
lngZeile = 1
Else
lngZeile = rngZelle.Row + 1
End If
'Spalte A - automatisch Nummerieren
.Cells(lngZeile, 1).Value = Application.WorksheetFunction.Max(.Columns(1)) + 1
'Value definiert den Wert zu übernehmen
'Kopfdaten start aus Zeile 1 und Bearbeiter (A40)
.Cells(lngZeile, 2).Value = wksEingabe.Range("C1").Value
.Cells(lngZeile, 3).Value = wksEingabe.Range("G1").Value
.Cells(lngZeile, 4).Value = wksEingabe.Range("B1").Value
.Cells(lngZeile, 5).Value = wksEingabe.Range("A40").Value
Dim intSpalte As Integer
Dim lngAusgang As Long
lngAusgang = 13 'Beginne Zeile 13
For intSpalte = 6 To 50 Step 4 'Fülle die Spalten 6 bis 50
.Cells(lngZeile, intSpalte).Value = wksEingabe.Cells(lngAusgang, 2).Value 'Daten _
_
_
aus 13 B
.Cells(lngZeile, intSpalte + 1).Value = wksEingabe.Cells(lngAusgang, 33).Value 'Daten _
_
_
aus 13 AG
.Cells(lngZeile, intSpalte + 2).Value = wksEingabe.Cells(lngAusgang, 3).Value 'Daten _
_
_
aus 13 C
.Cells(lngZeile, intSpalte + 3).Value = wksEingabe.Cells(lngAusgang, 4).Value 'Daten _
_
_
aus 13 D
lngAusgang = lngAusgang + 1 'Zeile wird hochgezählt
Next intSpalte
.Cells(lngZeile, 723).Value = wksEingabe.Range("D40").Value 'Direkte Übernahme von D40 in _
_
_
Spalte 723
.Cells(lngZeile, 46).Value = wksEingabe.Range("A26").Value 'Direkte Übernahme von A26 in _
_
_
Spalte 46
.Cells(lngZeile, 47).Value = wksEingabe.Range("A27").Value 'Direkte Übernahme von A27 in _
_
_
Spalte 47
.Cells(lngZeile, 48).Value = wksEingabe.Range("A28").Value 'Direkte Übernahme von A28 in _
_
_
Spalte 48
.Cells(lngZeile, 49).Value = wksEingabe.Range("A29").Value 'Direkte Übernahme von A29 in _
_
_
Spalte 49
.Cells(lngZeile, 50).Value = wksEingabe.Range("A30").Value 'Direkte Übernahme von A30 in _
_
_
Spalte 50
lngAusgang = 13
For intSpalte = 51 To 218 Step 7 'Spalte 51 bis 218
.Cells(lngZeile, intSpalte).Resize(, 6) = _
wksEingabe.Range(wksEingabe.Cells(lngAusgang, 13), _
wksEingabe.Cells(lngAusgang, 18)).Value 'Daten von Spalte M - R in betreffender _
Zeile
.Cells(lngZeile, intSpalte + 6) = wksEingabe.Cells(lngAusgang, 20).Value 'Daten aus _
Zelle T der betreffenden Zeile
lngAusgang = lngAusgang + 1 'Zeile wird hochgezählt
Next intSpalte
End With
End Sub