Bereich durchlaufen, Daten zusammenführen
05.05.2015 07:19:27
Captain
ich habe in meiner Mappe 30 Tabellen, 5 davon sind für meinen u.a. Code nicht relevant. Mein Code funzt auch, nur ist der leider sehr langsam :-(
In jeder der restlichen "Quelltabellen" (25) sollen alle Zellen im Bereich Q4:V20 nach Inhalten durchlaufen werden. Sind Werte vorhanden, sollen diese gebündelt und untereinander ab der Zelle G25 inkl. Nummerierung aufgeschrieben werden.
Warum ist der Code sooooo langsam? ;-(
Danke für euer Hilfe
Jack
Sub Wie_ofts()
End Sub
WS_Count = ActiveWorkbook.Worksheets.Count
For AnzTabellen = 1 To WS_Count
If Worksheets(AnzTabellen).Name = "tblÜberblick" Or Worksheets(AnzTabellen).Name = " _
Einstellungen" Or _
Worksheets(AnzTabellen).Name = "Template" Or Worksheets(AnzTabellen).Name = "Bilder" _
Or _
Worksheets(AnzTabellen).Name = "Auswertung" Then
'nix
Else
Worksheets(AnzTabellen).Select
intZielzeile = 26
With ActiveSheet
'alte Werte löschen
.Rows("26:50").Select
Selection.Delete Shift:=xlUp
'Quellspalte Q:V
For intSpaltenquelle = 17 To 22
'Quellzeile 4:20
For intZeilenQuelle = 4 To 20
If .Cells(intZeilenQuelle, intSpaltenquelle) "" Then
.Cells(intZielzeile, 7) = ActiveSheet.Cells(intZeilenQuelle, _
intSpaltenquelle)
'Nummerierung
.Cells(intZielzeile, 6) = intZielzeile - 25
intZielzeile = intZielzeile + 1
Else
'nix
End If
Next intZeilenQuelle
Next intSpaltenquelle
End With
End If
Next AnzTabellen
End Sub