Werte in Spalte summieren

Hallo,
ich habe ein Problem bezüglich der Addition von Werten aus einer Spalte.
Zuvor aber noch meine Problembeschreibung:
Ich habe 2 Tabellen (Tabelle1 und Tabelle3).
Die Struktur der Tabelle3 sieht wie folgendermaßen aus.
Fach1:
Spalte A: Person1
Spalte B: Person2
Spalte C: Person3
Spalte D: Person4
Fach2:
Spalte F: Person1
Spalte G: Person2
Spalte H: Person3
Spalte i: Person4
In Tabelle 3 können nun getrennt nach Personen die Werte eingegeben werden.
Die Tabelle 1 sieht wie folgt aus.
Spalte A: Person1
Spalte B: Person2
Spalte C: Person3
Spalte D: Person4
Ich möchte nun mittels VBA alle Werte von Person1 aus Tabelle3 in die Spalte A der Tabelle 1 kopieren. Soweit funktioniert noch alles wunderbar mittels folgendem Code:
Dim quelle As String
Dim ziel As String
quelle = "Tabelle3"
ziel = "Tabelle1"
Dim person1 As String 'erste leere Zeile ermitteln
Worksheets(quelle).Range("A3:A2000").Copy Destination:=Worksheets(ziel).Range("A2")
person1 = Sheets(ziel).Range("A65536").End(xlUp).Row + 1
Worksheets(quelle).Range("E3:E2000").Copy Destination:=Worksheets(ziel).Range("A" & person1)
person1 = Sheets(ziel).Range("A65536").End(xlUp).Row + 1
Worksheets(quelle).Range("i3:i2000").Copy Destination:=Worksheets(ziel).Range("A" & person1)
Nun kommt aber mein Problem. Ich habe in Tabelle1 lediglich 40 Zeilen zur Verfügung. Also muss ich schauen, dass diese 40 Zeilen durch das Kopieren nicht überschritten werden.
Meine Idee ist nun, dass ich mittels VBA prüfe, ob ich bereits in Zeile 40 auf der Tabelle1 bin und wenn ja, die restlichen Werte aus Tabelle3 addiere und in Zeile 40 einfüge.
Eine Addition von Werten kann ich mittels
MsgBox WorksheetFunction.Sum(Tabelle3.Range("E4:E" & Sheets(ziel).Range("E65536").End(xlUp).Row)), , "Hinweis"
realisieren.
Jedoch weiß ich nicht, wie ich beim Kopiervorgang die Zeilen abfrage und die RESTLICHEN Werte kopiere. Kopiere ich jede Zelle für sich dauert es ewig und verbraucht wohl sehr viel Arbeitsspeicher.
Weiß jemand Rat?
Sinn und Zweck ist es, dass ich zwei Druckansichten habe. Einmal die Möglichkeit über mehrere Seiten zu drucken und einmal alles auf einer Seite vereint zu haben.
Vielen Dank.
Mfg. Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Test Dim ZELLE As Long Dim i As Long Dim Summe As Double dim Quelle as Worksheet dim Ziel as Worksheet Set Ziel = Sheets("Tabelle1") Set Quelle = Sheets("Tabelle3") i = 2 For Each ZELLE In Sheets(Quelle).Range("A2:A2000,E2:E2000,I2:I2000").SpecialCells( _ xlCellTypeConstants, 1) If i 0 Then Sheets(Ziel).Cells(40, 1).Value = Summe End Sub

Hallo Andreas,
Quelle und Ziel sind schon als Worksheets deklariert. Deshalb muss in den Code-Zeilen das "Sheets(Quelle)" bzw. "Sheets(Ziel)" in "Quelle" bzw. "Ziel" geändert werden.

Sub Test()
Dim ZELLE As Variant
Dim i As Long
Dim Summe As Double
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Set Ziel = Sheets("Tabelle1")
Set Quelle = Sheets("Tabelle3")
i = 2
For Each ZELLE In Quelle.Range("A3:A2000,E3:E2000,I3:I2000").SpecialCells( _
xlCellTypeConstants, xlNumbers)
If i  0 Then Ziel.Cells(40, 1).Value = Summe
End Sub

Mein Alternativ-Vorschlag, der ggf. alle Personen in einer Schleife abarbeitet:


Sub aaatest()
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim Person As Long, SpaltenProFach As Long
Dim Fach As Long
Set wksQuelle = Worksheets("Tabelle3")
Set wksZiel = Worksheets("Tabelle1")
SpaltenProFach = 5 'Anpassen!!!! =Anzahl Spalten von Fach zu Fach
'  For Person = 1 To SpaltenProFach -1 '- 1 erforderlich für Leerspalte
Person = 1
wksZiel.Cells(1, Person) = wksQuelle.Cells(2, Person).Value
For Fach = 1 To 3 '3 ggf. Anpassen
Call Kopieren(SpalteQuelle:=Person + (Fach - 1) * SpaltenProFach, SpalteZiel:=Person, _
ZeileZiel:=IIf(Fach = 1, 2, 0))
Next Fach
'  Next Person
End Sub
Sub Kopieren(SpalteQuelle As Long, SpalteZiel As Long, _
Optional ZeileZiel As Long)
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
'ZeileZiel = 'nächste leere Zeile im Zielblatt, wenn =0 dann wird Zeile berechnet
Dim Bereich As Range
Set wksQuelle = Worksheets("Tabelle3")
Set wksZiel = Worksheets("Tabelle1")
With wksQuelle
'Spalte A (1) kopieren
'nächste freie Zelle in Ziel-Spalte
With wksZiel
If ZeileZiel = 0 Then ZeileZiel = .Cells(.Rows.Count, SpalteZiel).End(xlUp).Row + 1
End With
'Prüfen ob Daten vorhanden
If .Cells(.Rows.Count, 1).End(xlUp).Row >= 3 Then
Set Bereich = .Range(.Cells(3, SpalteQuelle), _
.Cells(.Rows.Count, SpalteQuelle).End(xlUp))
If ZeileZiel + Bereich.Rows.Count >= 40 Then
ZeileZiel = 40
wksZiel.Cells(ZeileZiel, SpalteZiel) = wksZiel.Cells(ZeileZiel, SpalteZiel) _
+ Application.WorksheetFunction.Sum(Bereich)
Else
Bereich.Copy Destination:=wksZiel.Cells(ZeileZiel, SpalteZiel)
End If
End If
End With
End Sub

Gruß
Franz

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

340 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte in Spalte summieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

340 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread