Sub copyData()
    Dim sh As Worksheet
    Dim lr1&, lr2&
    lr1 = Cells(Rows.Count, 1).End(xlUp).Row
    'Если старые данные стирать не нужно, то убрать следующий 2 строчки
    ThisWorkbook.Sheets("№1").Cells(1, 1).CurrentRegion.Offset(1).ClearContents
    ThisWorkbook.Sheets("№2").Cells(1, 1).CurrentRegion.Offset(1).ClearContents
    For i = 2 To lr1
        If Cells(i, 1) = 2 Then
            Set sh = ThisWorkbook.Sheets("№1")
        ElseIf Cells(i, 2) = 2 Then
            Set sh = ThisWorkbook.Sheets("№2")
        End If
        If Not sh Is Nothing Then
            With sh
                lr2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Cells(lr2, 1).Resize(, 7).Value = Cells(i, 3).Resize(, 7).Value
            End With
        End If
        Set sh = Nothing
    Next i
End Sub