AW: In Spalte Suchen und Zeile kopieren
11.01.2018 08:14:08
Sven
Guten Tag,
hat mir noch jemand ein Tipp, wie ich das Makro anpassen muss, dass nicht in der Zeile gesucht und kopiert wird sondern in der Spalte gesucht und kopiert wird?
Sub In_Zeile_suchen_Spalte_kopieren()
Dim TB1, TB2, TB3, TB4, TB5, TB6, LR1 As Double, LR2 As Double, LC As Integer, EZ1 As _
Integer, EZ2 As Integer, EZ3 As Integer, EZ4 As Integer, EZ5 As Integer, EZ6 As Integer
Dim Arr, Z, Spalte As Integer, ESp2 As Integer, ESp3 As Integer, ESp4 As Integer
Set TB1 = Sheets("Tabelle1")
Set TB2 = Sheets("Tabelle2")
EZ1 = 1 'Zeile in der gesucht wird
EZ2 = 2 'Zielzeile für Daten
ESp2 = 1 'erste ZielSpalte
Arr = Array("Rückmeldenummer", "Identität") 'die Suchbegriffe für Rohdaten
With WorksheetFunction
LR1 = .Max(EZ1, TB1.Cells.SpecialCells(xlCellTypeLastCell).Row) 'letze Spalte des _
gesamten Blattes
LR2 = .Max(EZ2, TB2.Cells.SpecialCells(xlCellTypeLastCell).Row)
'Reset ohne Überschriften
TB2.Rows(EZ2).Resize(LR2 - EZ2 + 1).ClearContents
If LR1 > EZ1 Then 'sind Werte vorhanden?
For Each Z In Arr
If .CountIf(TB1.Rows(EZ1), Z) > 0 Then 'Ist Suchbegriff in Zeile EZ1 =4 _
vorhanden?
Spalte = .Match(Z, TB1.Rows(EZ1), 0) 'in welcher Spalte steht der Begriff
'Übertragen ohne Überschrift
TB2.Cells(EZ2, ESp2).Resize(LR1 - EZ1 + 1).Value = _
TB1.Cells(EZ1 + 1, Spalte).Resize(LR1 - EZ1 + 1).Value
Else
'Fehlermeldung, wenn der Suchbegriff in Rohdaten nicht gefunden wird
MsgBox "Suchbegriff '" & Z & "' wurde nicht gefunden"
End If
ESp2 = ESp2 + 1 'nächste Spalte
Next
End If
End With
End Sub