Gewöhn dir unbedingt an, immer explizit dein Tabellenblatt (Worksheet) anzugeben, also ws.Range(...) und nicht nur Range(...) (das selbe gilt für Cells()). Ohne diese konkrete Angabe, kommt es darauf an wo der Code steht; anhand dessen wird entschieden zwischen ActiveSheet oder eines konkreten Tabellenblattes. Da das aktive Blatt auch ein Diagrammblatt sein könnte, bestünde auch noch das potentielle Problem eines Laufzeitfehlers -> also: immer explizit angeben, auf welches Tabellenblatt du dich beziehst. (das würde ich allgemein sogar als goldene Regel bezeichnen, egal welche Programmiersprache; "sei konkret")
Option Explicit gehört immer in die erste Zeile eines jeden Moduls. Dafür gibt es in den VBA Editor Einstellungen eine Option, die das autom. erledigt. Menü: Extras -> Optionen -> Editor: "Variablendekl. erforderlich".
Zellen müssen nicht selektiert werden - NIEMALS, außer du willst den Blick des Nutzers darauf lenken!
Wenn Zeilen lang werden, ist es oftmals gut diese manuell umzubrechen (mit einem Unterstrich, siehe Code unten).
Ich habe in dem Code die Logik nicht weiter betrachtet.
Option Explicit
Private Sub Datenübertragen()
Dim ws As Excel.Worksheet
Set ws = ActiveSheet 'oder z.B: Worksheets("Tabelle1")
Dim lrow1 As Integer
Dim lrow2 As Integer
Dim lcol As Integer
Dim i As Integer, x As Integer
Dim search As Variant
Dim y As Integer
Dim i2 As Integer
lrow1 = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lrow2 = Srow ' ?? woher kommt diese Variable Srow ?? Sie ist weder deklariert, noch initialisiert.
For i = Srow To lrow1
For x = 2 To lrow2
lcol = ws.Cells(x, ws.Columns.Count).End(xlToLeft).Column
If ws.Cells(i, 1).Value = ws.Cells(x, 1).Value Then
Call ws.Range(ws.Cells(x, 6), ws.Cells(x, lcol)).Copy(Destination:=ws.Range("F" & i))
i2 = i
i = i + 1
For y = 6 To lcol
ws.Cells(i, y) = Application.WorksheetFunction.SumIfs( _
Worksheets("Data_Input").Range("D:D"), _
Worksheets("Data_Input").Range("A:A"), _
ws.Cells(i2, y), _
Worksheets("Data_Input").Range("B:B"), _
ws.Cells(i2, 4))
Next y
End If
Next x
Next i
'Call CreateCharts
End Sub
|