求VBA代码

Question

先查找2工作表A列序列号，查到后将那一行的数据调1工作表指定区域B3到F3 到了F3自动转行B4开始
一直调到那一行最后面为空白停止，大神们，咋没有人解答

Answer 1

Sub 查找()
  zh = Range("A100000").End(xlUp).Row '数据最后行号
  arr = Range("A3:A" & zh) '原数据赋值
  Dim arr1 '定义目标数组
  ReDim arr1(1 To Int((zh - 2) / 5), 1 To 3) '重定义目标数组
  j = 1 '目标数组行初始化
  k = 0 '目标数组列初始化
  For i = 1 To zh - 2 '原数据循环
    If 【你的判断语句】 Then '条件符合则执行
      If k = 5 Then '列号判断
        k = 1 'k置1
      Else
        k = k + 1 'k加1
      End If
      arr1(j, k) = arr(i, 1) '转存
    End If
  Next i
  Range("B3:F" & UBound(arr1) + 2) = arr1 '赋值到指定单元格
End Sub