Sub График_паутинка()
'
' График_паутинка Макрос
'

'
Application.ScreenUpdating = False
Dim i As Long
For i = 4 To 7
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlRadar
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=Паутинка!$C$1"
    ActiveChart.SeriesCollection(1).Values = Range(Cells(i, 3), Cells(i, 17))
    ActiveChart.SeriesCollection(1).XValues = "=Паутинка!$C$2:$Q$2"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).Name = "=Паутинка!$R$1"
    ActiveChart.SeriesCollection(2).Values = Range(Cells(i, 18), Cells(i, 32))
    ActiveChart.SeriesCollection(2).XValues = "=Паутинка!$R$2:$AF$2"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(3).Name = "=Паутинка!$A$3"
    ActiveChart.SeriesCollection(3).Values = "=Паутинка!$R$3:$AF$3"
    ActiveChart.SeriesCollection(3).XValues = "=Паутинка!$R$2:$AF$2"
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).MaximumScale = 3
    ActiveChart.ApplyLayout (1)
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = Cells(i, 1)   'название диаграммы
     Next
Application.ScreenUpdating = True
End Sub

Sub Заполнить()
Application.ScreenUpdating = False
Dim i As Long
Dim iLastRow As Long
Dim Nomer As String
Dim FoundNomer As Range
   iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
   For i = 2 To iLastRow  'до последнего заполненного поля
     Nomer = Cells(i, 1)
     With Workbooks("БД16.xlsx").Worksheets("База")
       Set FoundNomer = .Columns(A).Find(Nomer, , xlValues, xlWhole)
       If Not FoundNomer Is Nothing Then
          Cells(FoundNomer.Row, 44) = .Cells(i, 10)  'Поступл.дата
          Cells(FoundNomer.Row, 47) = .Cells(i, 13)  'Процент занятости(ставка)
          Cells(FoundNomer.Row, 49) = .Cells(i, 12)  'Город
          Cells(FoundNomer.Row, 50) = .Cells(i, 3)  'Должность
          Cells(FoundNomer.Row, 51) = .Cells(i, 5)  'Группа
       Else
         Cells(i, 1).Interior.Color = 65535
       End If
     End With
   Next
Application.ScreenUpdating = True
End Sub

Sub тест3()
'
' тест3 Макрос
'

'
    Dim i As Integer
    Dim j As Integer
    For i = 1 To 5
    Cells(i, 1).Select
    Selection.Copy
    Windows("Сырые_данные.xlsm").Activate
    Range("A1").Select
    Cells.Find(What:=Cells(i, 1), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    

    Rows(j).Select
    Selection.Copy
    Windows("Обработка.xlsm").Activate
    Rows(i).Select
    ActiveSheet.Paste
    Next
End Sub