Change "EntireRow.Copy" in range
07.07.2022 10:03:23
Johannes
ich habe einen code gefunden, der mir genau das macht, was ich brauche und ihn angepasst.(fast)
Der code sucht in allen ws in den Zellen R8:R36 nach dem Text "good", und wenn er fündig wird, dann
kopiert er die ganze reihe auf die Seite "Best".
Ich hätte aber gerne nur die werte von "spalte S" bis "spalte AO" übernommen. Habe schon mit
xRRg.Range(Cells(Rng.Row, "S"), Cells(Rng.Row, "AO")).Copy
aber nix. Was mach ich falsch?
Danke
Johannes
Hier noch der ganze Code
Public Sub Copy_when_Found()
Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer
On Error Resume Next
Application.DisplayAlerts = False
xStr = "Best" ' result site
xRStr = "good" ' search string
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 5 'Start line '5
For Each xWs In ActiveWorkbook.Worksheets
If xWs.Name xStr Then
Set xRg = xWs.Range("R8:R36") ' search range
Set xRg = Intersect(xRg, xWs.UsedRange)
For Each xRRg In xRg
If xRRg.Value = xRStr Then
'xRRg.Range(Cells(Rng.Row, "S"), Cells(Rng.Row, "AO")).Copy
xRRg.EntireRow.Copy ' copy range
xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
xC = xC + 1
End If
Next xRRg
End If
Next xWs
Application.DisplayAlerts = True
End Sub