Sub Macro1() ' ' Macro1 Macro ' Test ' Sub CopyOnCondition() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim LR1 As Long Dim LR2 As Long Dim cl As Range Set ws1 = Workbooks("Workbook1").Sheets("sh1") Set ws2 = Workbooks("Workbook2").Sheets("sh1") LR = ws1.Cells(Rows.Count, "AL").End(xlUp).Row For i = 4 To LR1 Set cl = ws1.Cells(i, "AL") If cl = "X" Then ws1.Cells(cl.Row, "A").Resize(1, 28).Copy LR2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row ws2.Cells(LR2 + 1, "A").PasteSpecial Paste:=xlPasteValues End If Next i End Sub End Sub
ارسال نظر
ارسال نظر آزاد است، اما اگر قبلا در بیانثبت نام کرده اید می توانید ابتدا وارد شوید.
'
' Macro1 Macro
' Test
'
Sub CopyOnCondition()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LR1 As Long
Dim LR2 As Long
Dim cl As Range
Set ws1 = Workbooks("Workbook1").Sheets("sh1")
Set ws2 = Workbooks("Workbook2").Sheets("sh1")
LR = ws1.Cells(Rows.Count, "AL").End(xlUp).Row
For i = 4 To LR1
Set cl = ws1.Cells(i, "AL")
If cl = "X" Then
ws1.Cells(cl.Row, "A").Resize(1, 28).Copy
LR2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
ws2.Cells(LR2 + 1, "A").PasteSpecial Paste:=xlPasteValues
End If
Next i
End Sub
End Sub