Ich habe 18 Spalten, in denen sich wöchentlich die Einträge vermehren.
Diese Eintragungen sollen in einem anderes Blatt in eine Spalte kopiert werden.
Mit dem Makrorekorder komme ich nur bis Spalte "A".
Danke für Euere Hilfe.
Gruß
Walter
A | B | C | |
1 | |||
2 | 2-5A | ||
3 | 2-5A | ||
4 | 2-5A | 4-8B | |
5 | 2-5A | 4-8B | |
6 | 4-8B | ||
7 | 4-8B | 7-11C | |
8 | 4-8B | 7-11C | |
9 | 7-11C | ||
10 | 7-11C | ||
11 | 7-11C |
A | |
1 | |
2 | 2-5A |
3 | 2-5A |
4 | 2-5A4-8B |
5 | 2-5A4-8B |
6 | 4-8B |
7 | 4-8B7-11C |
8 | 4-8B7-11C |
9 | 7-11C |
10 | 7-11C |
11 | 7-11C |
A | B | |
1 | Liste | Tore |
2 | Lukas Heil | 2 |
3 | Lucas Unbehaun | 5 |
4 | Werner Wegendt | 10 |
5 | Jakob Kochim | 1 |
6 | Benjamin Panse | 1 |
7 | Nick Breiter | 2 |
8 | Marvin Correus | 5 |
9 | Sven Gruenwald | 6 |
10 | Leonard Tigler | 1 |
11 | Viktor Strak | 1 |
12 | Daniel Illenseer | 4 |
13 | Florian Koch | 1 |
14 | Thomas Luniger | 1 |
15 | Thomas Gruda | 1 |
16 | Fabien Berger | 18 |
17 | Marcel Stock | 3 |
Option Explicit
Sub zusammenfassen2()
Dim sp&, Loletzte&, x&, LoLetzte2&
Application.ScreenUpdating = False
With Tabelle2
.Columns("A:B").ClearContents
.Cells(1, 1) = "Liste"
.Cells(1, 2) = "Tore"
.Cells(1, 1).Font.Bold = True
.Cells(1, 2).Font.Bold = True
.Cells(1, 1).Interior.Color = vbYellow
.Cells(1, 2).Interior.Color = vbYellow
For sp = 2 To 16
Loletzte = Cells(Rows.Count, sp).End(xlUp).Row
For x = 1 To Loletzte
If Cells(x, sp) "" Then .Cells(LoLetzte2 + 1, 1) = Cells(x, sp)
LoLetzte2 = .Cells(Rows.Count, 1).End(xlUp).Row
Next
Next
.Select
End With
With Columns("A:B")
.EntireColumn.AutoFit
.RemoveDuplicates Columns:=1, Header:=xlYes
End With
Loletzte = Cells(Rows.Count, 1).End(xlUp).Row
With Range("B2")
.FormulaR1C1 = "=COUNTIF(Tabelle1!R4C2:R150C16,RC[-1])"
.AutoFill Destination:=Range("B2:B" & Loletzte)
End With
MsgBox "fertig", vbInformation
End Sub
Gruß Matthias