Makro Optimierung
19.01.2016 11:48:21
Lutz
die Beverly war so freundlich und hatte mir meinen Code optimiert.
Kann jemand vielleicht mal drüber schauen ob ich das richtig verstanden habe.
Ich habe dazu den Code mal versucht auszukommentieren.
VG und Danke.
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