AW: Inhalt von mehrere Laschen zusammenführen
10.02.2009 16:03:00
mehrere
Hallo Meli,
das Makro überträgt aus allen Blättern deren Name mit "P" beginnt die Dtaen in die Übersicht.
Die Übersicht wird schon nach den Namen sortiert.
Für das Sortieren in den Px-Blättern muss du die Prozedur wie folgt anpassen.
Gruß
Franz
Sub Uebersicht()
Dim wksUeber As Worksheet, lngZeileU As Long, lngSpaltePx As Long
Dim wksPx As Worksheet, lngZeilePx As Long
Dim rngZelle As Range, rngBereich As Range, rngPxComment As Range
Dim strPx As String
Dim bolLinks As Boolean 'Wenn True dann werden Links der Kommentare aus früheren Perioden _
eingefügt, wenn False dann die Kommentartexte
Set wksUeber = Worksheets("Übersicht")
If MsgBox("Kommentare früherer Perioden als Text einfügen?" & vbLf & vbLf _
& "Bei Nein werden Links eingefügt", vbYesNo + vbQuestion, _
"Übersicht erstellen") = vbYes Then
bolLinks = True
Else
bolLinks = False
End If
With wksUeber
'Altdaten löschen
If .Cells.SpecialCells(xlCellTypeLastCell).Row >= 3 Then
.Range(.Rows(3), .Rows(.Cells.SpecialCells(xlCellTypeLastCell).Row)).ClearContents
.Range(.Cells(2, 8), .Cells(2, .Columns.Count)).ClearContents
End If
End With
lngZeileU = 2
Application.ScreenUpdating = False
lngSpaltePx = 7 'Spaltenzähler weitere kommentare
For Each wksPx In ActiveWorkbook.Worksheets
With wksPx
'1. Buchstaben des Blattnamens Prüfen, wenn ="P" Daten --> Übersicht ##### 2009-02-10
If Left(wksPx.Name, 1) = "P" Then
'Titelzeile ergänzen
lngSpaltePx = lngSpaltePx + 1
'Achtung der Wert von "Left(.Cells(1, 1).Value, 3)" = Periode wird später zum _
Suchen benötigt um frühere Einträge eines Kunden zuzuordnen. Vorsicht bei Änderungen
wksUeber.Cells(2, lngSpaltePx).Value = "Comments in " & Left(.Cells(1, 1).Value, 3)
'Neu ### Anfang 2009-02-10
'Daten sortieren
'Daten sortieren Spalten A bis G
If .Cells(.Rows.Count, 2).End(xlUp).Row > 11 Then
Set rngBereich = .Range(.Cells(10, 1), .Cells(.Rows.Count, 2).End(xlUp).Offset(0, 5))
'Daten Sortieren nach customer (Aufsteigend)
With rngBereich
.Sort Key1:=.Range("B1"), Order1:=xlAscending, _
OrderCustom:=1, Orientation:=xlTopToBottom, _
Header:=xlYes
End With
End If
'Daten sortieren Spalten I bis O
If .Cells(.Rows.Count, 10).End(xlUp).Row > 11 Then
Set rngBereich = .Range(.Cells(10, 9), .Cells(.Rows.Count, 10).End(xlUp).Offset(0, 5)) _
'Daten Sortieren nach customer (Aufsteigend)
With rngBereich
.Sort Key1:=.Range("B1"), Order1:=xlAscending, _
OrderCustom:=1, Orientation:=xlTopToBottom, _
Header:=xlYes
End With
End If
'Neu ### Ende 2009-02-10
'Alle Sales-Einträge übertragen
'usw.