Страницы: 1
RSS
Копирование из строки определенного листа нужные ячейки и вставить в другую книгу в следующую свободную строку
 
Здравствуйте. Подскажите пожалуйста, очень нужна Ваша помощь!!! У меня есть макрос, который копирует из книги (под названием "Заполнение") определенную строку и и вставляет в другую книгу (под названием Хранение) в следующую свободную строку, нужно тоже самое, только, чтобы копировал из определенной строки нужные ячейки ("A2", "C2", ""E2","F2", "H2").
Код
Sub Запись()
Application.ScreenUpdating = False
'Обращаться с книгами будем через переменные
'(кода меньше писать и не промахнёшься мимо нужной книги)
Dim Исходная As Excel.Workbook, Конечная As Excel.Workbook
Dim nss As Long
Set Исходная = ActiveWorkbook
'открываем книгу
Set Конечная = Workbooks.Open("D:\Данные\Хранение.xlsm")
'копируем строку
        Исходная.Worksheets(1).Rows("2:2").Copy
        'выбираем номер начальной строки для поиска последней записи
        nss = 2
        'ищем последнюю запись
        Do While Конечная.Worksheets(1).Range("B" & nss).Value <> ""
            'увеличиваем номер строки на 1
            nss = nss + 1
        Loop
        'вставляем строку из буфера
        Конечная.Worksheets(1).Rows(nss).PasteSpecial
        Конечная.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
Изменено: Lerik2020 - 15.01.2020 00:53:33
 
Форумчане, ну что совсем без вариантов?
Изменено: Lerik2020 - 15.01.2020 00:54:15
 
Lerik2020, не очень понял

ну попробуйте заменить строку  
Код
Исходная.Worksheets(1).Rows("2:2").Copy
на
Код
 Исходная.Worksheets(1).Range("A2,C2,E2,F2,H2").Copy
Не бойтесь совершенства. Вам его не достичь.
 
Спасибо, что откликнулись, но мне уже подсказали
Код
Sub transponir() ' переносим файлы в общий отчет
Application.ScreenUpdating = False
Dim x1 As Long, rn As Range
Set rn = Range("A2", "H2")
Workbooks.Open Filename:="D:\Данные\Хранение.xlsm" ' открываем файл
Workbooks("Хранение.xlsm").Worksheets("Лист1").Activate
x1 = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(x1, 1), Cells(x1 + rn.Rows.Count - 1, 1)).NumberFormat = "@"
Range(Cells(x1, 1), Cells(x1 + rn.Rows.Count - 1, rn.Columns.Count)).Value = rn.Value
Range(Cells(x1, 9), Cells(x1 + rn.Rows.Count - 1, 25)).ClearContents
Range(Cells(x1, 2), Cells(x1 + rn.Rows.Count - 1, 2)).ClearContents
Range(Cells(x1, 4), Cells(x1 + rn.Rows.Count - 1, 4)).ClearContents
Range(Cells(x1, 7), Cells(x1 + rn.Rows.Count - 1, 7)).ClearContents
ActiveWorkbook.Close 1 'закрываем с сохранением
Application.ScreenUpdating = True
End Sub

Изменено: Lerik2020 - 15.01.2020 12:54:18
Страницы: 1
Наверх