SubTestMoveData()
Dimwsh1AsWorksheet
Dimwsh2AsWorksheet
Setwsh1=Application.Workbooks("A.xlsx").Sheets("Sheet1")
Setwsh2=Application.Workbooks("B.xlsx").Sheets("Sheet1")
DimaLastAsLong
aLast=wsh1.Range("B:B").Find("*",,,,,xlPrevious).Row
Dimarr1()
arr1=wsh1.Range("B2").Resize(aLast-2+1,1)
Dimarr2()
arr2=arr1
DimxAsLong
DimyAsLong
y=1
Forx=1ToUBound(arr1,1)
Ifarr1(x,1)="yes"Then
arr2(y,1)=arr1(x,1)
y=y+1
EndIf
Next
arr2=Application.WorksheetFunction.Transpose(arr2)
ReDimPreservearr2(1Toy-1)
arr2=Application.WorksheetFunction.Transpose(arr2)
wsh2.Range("B21").Resize(y-1,1)=arr2
EndSub
