От чего же ошибка в Pastespecial?

Question

Коллеги! Помогите разобраться: никак не получается вставить только значения (с изначальным форматированием из файла-источника получается, а вставить только значения в файл-получатель не получается).

Sub GetTransactions()

    Dim my_FileNameLong As Variant
    Dim my_FileNameShort As Variant
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim ListName As String
    Dim FinalRow As Integer
    Dim i As Long
    
    Set wb = ThisWorkbook
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculateManual
    
    'Открываем файл (только для чтения) с операциями за текущий месяц + определяем переменную my_FileName
    my_FileNameLong = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")
    
    If my_FileNameLong <> False Then
        Workbooks.Open Filename:=my_FileNameLong, ReadOnly:=True
    End If
    
    'Определяем короткое имя файла с операциями, чтобы потом (после копирования данных) его закрыть по имени
    my_FileNameShort = ActiveWorkbook.Name
    
    'Определяем имя закладки, с которой будем брать информацию
    ListName = InputBox("Введите имя листа, с которого берём информацию")
    
    Worksheets(ListName).Activate
    
    'Работаем с информацией на выбранной закладке:
    'Определяем последнюю строку на выбранном листе в файле-источнике
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 4 To FinalRow
        'Sheets(ListName).Range("aw" & i & ":cj" & i).Copy wb.Sheets("CAPEX").Range("a" & Rows.Count).End(xlUp).Offset(1)
        Sheets(ListName).Range("aw" & i & ":cj" & i).Copy
        wb.Sheets("CAPEX").Range("a" & Rows.Count + 1 & ":an").PasteSpecial xlPasteValues
    Next i
    
    Application.CutCopyMode = False
    
    'Закрываем ранее открытую книгу, из которой предварительно забрали все данные
    Workbooks(my_FileNameShort).Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

Answer 1

wb.Sheets("CAPEX").Range("a" & Rows.Count + 1 & ":an").PasteSpecial xlPasteValues

В этой строке сразу три ошибки.

Не указана строка для столбца an
Rows.Count + 1 - количество строк на листе + 1. Не строк с данными, а всего строк. Естественно, что обращение к строке, которой не существует (ниже последней) вызовет ошибку.
Грабли, на которые часто наступают по незнанию. Rows.Count - количество строк на АКТИВНОМ листе. Пример ошибки: активный лист книги формата .xlsm (Rows.Count= 1048576), а определяем размер для книги формата .xls (на листе 65536 строк).
Не ошибка, но лишнее: не обязательно указывать размер вставки, достаточно обозначить верхнюю левую ячейку диапазона.

Попутно по коду.

Проверяем, выбрана ли книга:

If my_FileNameLong <> False Then

Если не выбрана, книга не открывается, но код продолжает работать с ActiveWorkbook, т.е. с ThisWorkbook. А нужно принудительно завершать работу.

В InputBox нужно указать имя листа. Если такого имени нет - ошибка. Нужно или проверять после этого наличие листа, или статично указывать имя листа в коде (если выбор не обязателен).

Range("aw" & i & ":cj" & i)

Запись диапазона синтаксически правильная, но читается плохо. Сравните:

Range("AW" & i).Resize(1, 40)
Cells(i,49).Resize(1, 40)

Application.Calculation - имеет смысл отключать пересчет, если на листе много вычислений, которые могут запуститься при вставке данных.

Цикл по строкам. Обращение к объектам листа медленная. Тем более, что на каждом шаге цикла по два обращения - при копировании и при вставке. И чем больше, тем дольше макрос работает.

В этой задаче не нужен цикл, достаточно копировать/вставить весь диапазон.

Если есть необходимость в цикле (например, выборка данных в каждой строке по условиям), то с помощью массивов можно минимизировать обращение к листам: 1 - взять данные с листа в массив и 2 - выгрузить данные на лист. Все, что между 1 и 2, выполняется виртуально, в оперативке.

С учетом замечаний код можно записать в такой редакции:

Sub GetTransactions_()
    Dim my_FileNameLong As String, ListName As String
    Dim FinalRow As Long

    my_FileNameLong = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")
    If my_FileNameLong = "False" Then Exit Sub
    
    Call OptionsEnable_Disable(False)
    
    With Workbooks.Open(Filename:=my_FileNameLong)
        ListName = InputBox("Введите имя листа, с которого берём информацию")
        If fCorrectNameSheet(ListName) = False Then Exit Sub

        With Worksheets(ListName)
            FinalRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            .Range("AW4").Resize(FinalRow - 3, 40).Copy
        End With
        
        With ThisWorkbook.Worksheets("CAPEX")
            FinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Cells(FinalRow + 1, 1).PasteSpecial xlPasteValues
        End With
    
        .Close
    End With

    Call OptionsEnable_Disable(True)
    MsgBox "OK", 64, ""
End Sub

Sub OptionsEnable_Disable(bFlag As Boolean)
    With Application
        .CutCopyMode = False
        .ScreenUpdating = bFlag
        .DisplayAlerts = bFlag
        
        If bFlag = False Then
            .Calculation = xlCalculateManual
        Else
            .Calculation = xlCalculationAutomatic
        End If
    End With
End Sub

Function fCorrectNameSheet(ListName As String) As Boolean
    Dim sht As Worksheet
    
    For Each sht In Worksheet
        If sht.Name = ListName Then
            fCorrectNameSheet = True
            Exit Function
        End If
    Next sht
End Function

БЛОГ НА HUSL

От чего же ошибка в Pastespecial?

Ответы (1 шт):