Копирование одновременно четырех строк с данными на другой лист в ячейки

[Влад Прошкин]

Здравствуйте. Прошу помощи, так как сам не силен в написании макроса. Задача:  нужно из листа А перенести данные первых четырех строк на лист В в определенные ячейки , потом следующие 4 строки и т.д., а из листа В из этих ячеек вставить данные в форму 5.
На лист А  будут копироваться данные из другой книги в ручную.
Прилагаю два файла один с формой 5 и написанным макросом, который написал сам как-то, но форма 5 не по размерам и нас заставили переделать по стандарту,второй файл так как нужно организации с ячейками в которые нужно закинуть данные и формой 5 на листе С.

макрос для файла "форма 5"

Код Выделить Развернуть

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Columns(9)) Is Nothing Then
      txt = Cells(ActiveCell.Row, 9)    ' Ф.И.О
    strFamily = Split(Application.Trim(txt), " ")(0)
    strName = Split(Application.Trim(txt), " ")(1)
    strSurname = Split(Application.Trim(txt), " ")(2)
     
            Sheets(1).Cells(6, 4) = strFamily
            Sheets(1).Cells(7, 4) = strName
            Sheets(1).Cells(8, 4) = strSurname
   
   rojdat = Cells(ActiveCell.Row, 10)     'год рождения
   
    rchdat = Split(Application.Trim(rojdat), "/")(0)
    rmdat = Split(Application.Trim(rojdat), "/")(1)
    rgdat = Split(Application.Trim(rojdat), "/")(2)
     
            Sheets(1).Cells(11, 3) = rchdat
            Sheets(1).Cells(11, 1) = rmdat
            Sheets(1).Cells(11, 5) = rgdat
           
  pribdat = Cells(ActiveCell.Row, 7)    ' дата прибытия
   
    pchdat = Split(Application.WorksheetFunction.Trim(pribdat), ".")(0)
    pmdat = Split(Application.WorksheetFunction.Trim(pribdat), ".")(1)
    pgdat = Split(Application.WorksheetFunction.Trim(pribdat), ".")(2)
     
            Sheets(1).Cells(41, 1) = pchdat
            Sheets(1).Cells(41, 2) = pmdat
            Sheets(1).Cells(41, 3) = pgdat
           
            Sheets(1).Cells(43, 4) = pchdat
            Sheets(1).Cells(43, 5) = pmdat
            Sheets(1).Cells(43, 6) = pgdat
           
    vyibdat = Cells(ActiveCell.Row, 8)    ' дата выбытия
   
    vchdat = Split(Application.WorksheetFunction.Trim(vyibdat), ".")(0)
    vmdat = Split(Application.WorksheetFunction.Trim(vyibdat), ".")(1)
    vgdat = Split(Application.WorksheetFunction.Trim(vyibdat), ".")(2)
     
            Sheets(1).Cells(41, 4) = vchdat
            Sheets(1).Cells(41, 5) = vmdat
            Sheets(1).Cells(41, 6) = vgdat
End If
End Sub


[kuklp1]

Ни в одном из Ваших файлов нет листов А, В и С и тем более ни в одном нет макроса:

один с формой 5 и написанным макросом

Но время на скачку, открытие файлов и чтение Вашего(бестолкового, согласитесь) описания я уже потерял

[Влад Прошкин]

если читать правила, то файлы с макросом нельзя загружать, я же на писал какой макрос нужен для файла "форма 5" просто вставить его и всЁ.
А насчет листов пусть будет так лист1, лист2, лист3 - суть не в этом как они называются

[Влад Прошкин]

а вот для файла "5" нужен макрос, я уже думаю может с чекбоксами, что-то получится. Куда копать то?