Ich habe ein Makro, das basierend auf den Kopfzeilen das gesamte Blatt 2 nach Blatt 1 kopiert.

Zum Beispiel,

Blatt 2 hat mehrere Spalten und Blatt 1 hat nur 5 oder 6 Spalten mit den Überschriften von Blatt2. Mit dem folgenden Skript zieht Blatt 1 die komplette Zeile; basierend auf den Überschriften von Blatt 2 (Beispiel: 10). Jetzt muss ich das Skript ein wenig modifizieren, sodass es nur hervorgehobene (in Rot) Zeilen aus Blatt 2 basierend auf den Überschriften zieht (Beispiel: 2 Zeilen). Bitte helfen Sie.

Untermakro1 ()
Dim Rng As Range, c As Range
Dimmen Sie die Zelle als Bereich
Dimmen Sie rSize so lang
Ziel als Bereich dimmen
HeaderRng als Bereich dimmen
Dimmen Sie lDestRow so lange
Dim i Als Ganzzahl
Application.ScreenUpdating = False 'Nach dem Testen auskommentieren

Blätter("Basisblatt").Auswählen
i = 0
Setze Rng = Range([D1], [D1].End(xlToRight))


Für jedes c in Rng


Setze sCell = Sheets("Roster").Range("1:1").Find(what:=c.Value, LookIn:=xlValues, lookat:=xlWhole)
rSize = Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Cells.Count

Wenn c.Offset(1, 0).Value <> "" Dann
'c.End(xlDown).Offset(1, 0).Resize(rSize, 1) = Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells( xlCellTypeVisible).Value
Setze dest = c.End(xlDown).Offset(1, 0)
Wenn ich = 0 dann
lDestRow = dest.Row
End If

Wenn dest.Row < lDestRow Dann
Setze dest = Cells(lDestRow, dest.Column)
End If

Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
Ziel auswählen
ActiveSheet.Paste


sonst
'c.Offset(1, 0).Resize(rSize, 1).Value = Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Value

Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
Setze dest = c.Offset(1, 0)

Wenn dest.Row < lDestRow Dann
Setze dest = Cells(lDestRow, dest.Column)
End If

Ziel auswählen
ActiveSheet.Paste
End If

i = i + 1
Weiter
Application.ScreenUpdating = True

End Sub