Макрос перенос данных из нескольких столбцов в один

Пользователь

Сообщений: 4 Регистрация: 03.04.2018

04.04.2018 12:44:46

Добрый день!

Нашел вот такую тему (открываю новую потому что в архиве уже) https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=12264 в принципе с рабочим решением, но есть вопрос - как доработать текущий макрос, чтобы если в копируемых столбцах есть формулы, в объединенный столбец копировались только значения?

Заранее спасибо!

Прикрепленные файлы

post_96223.xls (35.5 КБ)

ocet p

Пользователь

Сообщений: 448 Регистрация: 24.03.2018

04.04.2018 17:25:02

Например, таким образом:

Код

Sub Macros1()
Dim i As Long, iLastColumn As Long, iLastRow As Long, lastRow As Long

    iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lastRow = Cells(Rows.Count, 4).End(xlUp).Row
    
    For i = 2 To 3
        iLastRow = Cells(Rows.Count, i).End(xlUp).Row
        
        If lastRow = 1 Then
            'Range(Cells(1, i), Cells(iLastRow, i)).Copy Cells(lastRow, 4)
            Cells(lastRow, 4).Resize(iLastRow, 1).Value = Range(Cells(1, i), Cells(iLastRow, i)).Value
        Else
            'Range(Cells(1, i), Cells(iLastRow, i)).Copy Cells(lastRow + 1, 4)
            Cells(lastRow + 1, 4).Resize(iLastRow, 1).Value = Range(Cells(1, i), Cells(iLastRow, i)).Value
        End If
        
        lastRow = Cells(Rows.Count, 4).End(xlUp).Row
    Next
End Sub