ich habe 2 Fragen an euch:
1. Besteht eine sinnvolle Möglichkeit, dass "Sortieren"-Modul mit dem Zusammenschreiben-Makro zu verbinden. Sprich, man muss nur einmal die Schaltfläche betätigen?
Sub Zusammenschreiben()
Dim ws As Worksheet
Dim wsTotal As Worksheet
Dim lngLastCol As Long
Dim lngLastRow As Long
Dim rngTotalFound As Range
Dim lngTotalRow As Long
Dim lngCounter As Long
Dim strSearch As String
Dim sTabs As String
'Tabellen, die zusammengeführt werden sollen
sTabs = "*Tabelle2*Tabelle4*Tabelle5*"
On Error GoTo Zusammenschreiben_Error
Application.ScreenUpdating = False
Set wsTotal = Sheets("Tabelle6")
'** Clear Used-Range ohne Ünerschriftzeile (Piet)
wsTotal.UsedRange.Offset(1, 0).Delete
For Each ws In Worksheets
If InStr(1, sTabs, "*" & ws.Name & "*", vbTextCompare) > 0 _
Then
lngTotalRow = wsTotal.Cells(Rows.Count, "A").End(xlUp).Row + 1
Debug.Print lngTotalRow
With ws
lngLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
lngLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
.Range("A2:A" & lngLastRow).Copy Destination:=wsTotal.Range("A" & lngTotalRow) 'Spalte A _
_
.Range("B2:J10" & lngLastRow).Copy Destination:=wsTotal.Range("G" & lngTotalRow) 'Spalten _
_
End With
End If
Next ws
With wsTotal
lngTotalRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("B1:F1").Copy
.Range("B2:F" & lngTotalRow).PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
End With
'** Rahmen senkrecht - neu eingefügt - (Piet)
lngLastRow = wsTotal.Range("A1").End(xlDown).Row
With wsTotal.Range("A1:A" & lngLastRow)
.Offset(0, 0).Borders(xlEdgeRight).LineStyle = xlContinuous
.Offset(0, 5).Borders(xlEdgeRight).LineStyle = xlContinuous
End With
'** Rahmen senkrecht - Ende -
exit_here:
Set rngTotalFound = Nothing
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub
Zusammenschreiben_Error:
MsgBox "Fehler " & Err.Number & " (" & Err.Description & ") in der Prozedur Zusammenschreiben"
Resume exit_here
End Sub
SortierenSub Schaltfläche1_Klicken()
Range("A2:O25").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
2. Wenn beim SVERWEIS der Wert 0 (kein Inhalt) rauskommt - wie bleibt die betroffene Zelle nach dem Makrodurchlauf auch leer (ohne den "0" Eintrag). Muss sie immer manuell bearbeiten.Das Makro entstand mit der Hilfe von "Piet" und "Werner", Mitglieder dieses Forums. Danke euch beiden nochmal.
Hier noch die Beispieldatei zum besseren Verständnis:
https://www.herber.de/bbs/user/105609.xlsm
Danke für eure Hilfe