AW: Betrifft: AW: Dringend: Anpassung/Änderung eines V
Erich
Hi Manu,
hier zunächst mal der Beitrag, auf den du dich vermutlich beziehst:
https://www.herber.de/forum/archiv/1220to1224/t1222480.htm#1223368
Probier mal
Option Explicit
Sub tabellen_zusammenfassen()
Dim refNr As Range, sNr As Range, i As Integer, j As Integer
Dim lZeile1 As Long, lZeile2 As Long, lZeile3 As Long
Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Set wks1 = Worksheets("Tabelle R")
Set wks2 = Worksheets("Tabelle P")
Set wks3 = Worksheets("Tabelle M")
lZeile1 = wks1.Cells(Rows.Count, 1).End(xlUp).Row
lZeile2 = wks2.Cells(Rows.Count, 1).End(xlUp).Row
lZeile3 = wks3.Cells(Rows.Count, 1).End(xlUp).Row
With wks1
If lZeile1 > 1 Then .Range(.Cells(2, 1), .Cells(lZeile1, 18)).ClearContents
lZeile1 = 2
For Each refNr In wks2.Range(wks2.Cells(2, 1), wks2.Cells(lZeile2, 1))
If refNr "" Then
.Cells(lZeile1, 1).Resize(, 10) = refNr.Resize(, 10).Value
j = 0
For Each sNr In wks3.Range(wks3.Cells(2, 1), wks3.Cells(lZeile3, 1))
If refNr = sNr Then
j = j + 1
.Cells(lZeile1, 1) = sNr.Value
.Cells(lZeile1, 11).Resize(, 8) = sNr.Offset(0, 1).Resize(, 8).Value
If j > 1 Then
.Cells(lZeile1, 1).Resize(, 10) = refNr.Resize(, 10).Value
End If
lZeile1 = lZeile1 + 1
End If
Next
lZeile1 = lZeile1 + 1
End If
Next
End With
End Sub
Noch eine Bemerkung:
Es ist wenig sinnvoll, den Code in den Modulen der Arbeitsmappe und der Blätter zu speichern.
Besser untergebracht wäre er in einem "normalen" Modul ("Einfügen Modul"...)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort