Sub MoveDataToReport()
Dim whIn As Worksheet, whOut As Worksheet, arrIn, arrOut, lngI As Long, lngJ As Long
Set whIn = Worksheets("upload"): Set whOut = Worksheets("req")
With whIn
arrIn = .Range("A1").CurrentRegion.Value2
ReDim arrOut(1 To UBound(arrIn, 1), 1 To 4)
End With
For lngI = 2 To UBound(arrIn, 1)
If arrIn(lngI, 10) = "SM10" Then
lngJ = lngJ + 1
arrOut(lngJ, 1) = arrIn(lngI, 1) & " " & arrIn(lngI, 9) & " " & arrIn(lngI, 11)
arrOut(lngJ, 2) = DateSerial(Left(arrIn(lngI, 2), 4), Mid(arrIn(lngI, 2), 5, 2), Right(arrIn(lngI, 2), 2))
arrOut(lngJ, 3) = "частное лицо": arrOut(lngJ, 4) = arrIn(lngI, 8)
End If
Next lngI
With whOut
.Range("A2").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).Clear
.Range("A2").Resize(lngJ, 4) = arrOut
.Range("B2:B" & lngJ).NumberFormat = "dd.mm.yyyy"
End With
End Sub
З.Ы. Предлагаю название: Реформирование данных, перенос в другую таблицу по наличию значения в строке.