Я думаю, что это достигнет того, что вы ищете:
Sub CopyYes()
Dim myCell As Range
Dim LastColumnSource As Long 'Integer data type is outdated.
Dim LastRowTarget As Long
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim SourceRange As Range
Dim TargetRange As Range
Dim myArray As Variant
Set SourceSheet = ActiveWorkbook.Worksheets("Sheet1") <~~ change to your sheet name
Set TargetSheet = ActiveWorkbook.Worksheets("Sheet2") <~~ change to your sheet name
'Change the 1 to whichever column you need (1 represents column A)
LastRowTarget = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastRowSource = SourceSheet.Cells(Rows.Count, 3).End(xlUp).Row
Set SourceRange = SourceSheet.Range("C4:C" & LastRowSource)
j = 4
For Each myCell In SourceRange
If myCell.Value = "X" Then
LastColumnSource = SourceSheet.Cells(myCell.Row, Columns.Count).End(xlToLeft).Column
myArray = SourceSheet.Range(Cells(myCell.Row, 1), Cells(myCell.Row, LastColumnSource))
LastColumnTarget = TargetSheet.Cells(LastRowTarget, Columns.Count).End(xlToLeft).Column
Set TargetRange = TargetSheet.Range("A" & LastRowTarget)
TargetRange.Resize(1, UBound(myArray, 2)) = myArray
LastRowTarget = LastRowTarget + 1
End If
Next myCell
End Sub
Чтобы сделать его динамическим c, последняя строка и последний столбец найдены для обоих листов, и строка записана в массив затем написать обратно на лист результатов (что позволяет избежать использования копии).
Поскольку я недостаточно знаю о вашем проекте, я оставил ActiveWorkbook
, но вам лучше указать рабочую книгу (или ThisWorkbook, если это рабочая книга, из которой запускается код) - Это позволяет избежать ошибок времени выполнения, если код выполняется, пока другая книга находится в фокусе.