Vba ошибка при копировании

Avoid using Select (and Selection and Activate) wherever possible:

Sub ArchiveWeek()
    Set thisMon = Worksheets("Daily Itemized").Range("F5") 'Assigns variable thisMon as the date value in Daily Itemized Tab, F5 cell

    Dim ws As Excel.Worksheet
    Dim FoundCell As Excel.Range

    Set ws = Worksheets("Daily Summary Record")
    Set FoundCell = ws.Range("D:D").Find(what:=thisMon, lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
        'Copy range on Daily sheet
        Worksheets("Daily Itemized").Range("G5:S11").Copy
        'Paste it on the summary sheet commencing one cell
        ' to the right of the location of the date
        FoundCell.Offset(0, 1).PasteSpecial xlPasteValues
        MsgBox ("Your week time values have been pasted!")
    Else
        MsgBox ("The Date of " & thisMon & " was not found in the Daily Summary Record, Column D. Recheck values.")
    End If

Also, because you are only wanting to copy values, you could improve your code by by-passing the clipboard (with all the associated risks of the user copying something else to the clipboard between when your code executes the Copy and when it executes the Paste) and just setting the Values in the destination area to be the Values in the source area:

Sub ArchiveWeek()
    Set thisMon = Worksheets("Daily Itemized").Range("F5") 'Assigns variable thisMon as the date value in Daily Itemized Tab, F5 cell

    Dim ws As Excel.Worksheet
    Dim FoundCell As Excel.Range

    Set ws = Worksheets("Daily Summary Record")
    Set FoundCell = ws.Range("D:D").Find(what:=thisMon, lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
        'Copy values from Daily sheet to Summary sheet, commencing
        ' one cell to the right of the location of the date
        FoundCell.Offset(0, 1).Resize(7, 13).Value = _
                    Worksheets("Daily Itemized").Range("G5:S11").Value
        MsgBox ("Your week time values have been pasted!")
    Else
        MsgBox ("The Date of " & thisMon & " was not found in the Daily Summary Record, Column D. Recheck values.")
    End If

Источник
 

webley

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

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

Всем добрый день!  

  Никто не сталкивался с такой проблемой — периодически возникает ошибка при копировании листа через VBA:  
«Метод Copy из класса Worksheet завершен не верно»  
Причем, что самое интересное, ошибка возникает именно периодически и исчезает через некоторое время сама собой и код отрабатывается без проблем. Проводил проверку — при возникновении этой ошибки открываю новую книгу Excel, включаю макрорекордер, копирую лист — это действие не записывается.    

  Нет ли у кого-нибудь идей что это такое и как с этим жить?  
Спасибо  

  PS Excel 2007 SP2
 

nerv

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

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

Переустановить Office нет желания?)
 

webley

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

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

{quote}{login=nerv}{date=01.08.2011 10:04}{thema=}{post}Переустановить Office нет желания?){/post}{/quote}  

  Может и есть, но поскольку компьютер рабочий, то тут учитывается желание наших IT-шников, и мне кажется, что это не поможет, т.к. эта ошибка наблюдается как минимум еще на одном компьютере (кстати, одновременно с моим…)
 

nerv

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

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

от вирусов надежно защищены? Может быть в последнее время на обе машины устанавливалось каое-либо ПО, которое влияет на работу пакета MS Office?
 

nerv

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

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

Еще предположение: надстройки для Excel, плюс проверьте Personal.xls.  

  Вы точно уверены, что дело не в макросе?
 

webley

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

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

Да, уверен — дело точно не в макросе. Personal.xls у меня вообще нет. Одно и то же ПО — наверное вряд ли, но надо будет уточнить. А вот вирусы… Это вопрос.  

  Спасибо.
 

Лист копируется в эту же книгу, или в другую?  
Не защищена ли книга?
 

webley

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

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

{quote}{login=Казанский}{date=01.08.2011 11:00}{thema=webley}{post}Лист копируется в эту же книгу, или в другую?  
Не защищена ли книга?{/post}{/quote}  

  в другую. Книга не защищена. Еще раз подчеркиваю, что эта ошибка возникает периодически, обычно макрос отрабатывается нормально
 

nerv

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

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

 

Может, кто-то периодически включает общий доступ к книге?
 

webley

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

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

{quote}{login=nerv}{date=01.08.2011 11:47}{thema=to webley}{post}А можно код посмотреть?{/post}{/quote}  

  Да, конечно. Вот начало модуля, ошибка происходит при копировании. Думаю, этого кусочка достаточно, если нет — могу выложить весь код, но проверить его работоспособность все равно не получится, т.к. он оперирует файлами, лежащими на сервере  

    Sub Analitic()  
   Dim r, c  

     Set WBres = Workbooks.Open(PathStr & «МОНИТОРИНГ КЛИЕНТОВ.xlsm»)  

         ‘создаем временную книгу и копируем туда необходимые листы из разных книг  
   Set WBanalitic = Workbooks.Add  
   WBres.Sheets(«Data»).Copy after:=WBanalitic.Sheets(WBanalitic.Sheets.Count)  
   WBlut.Sheets(«LUT»).Copy after:=WBanalitic.Sheets(WBanalitic.Sheets.Count)  
   WBlut.Sheets(«CU_add_date»).Copy after:=WBanalitic.Sheets(WBanalitic.Sheets.Count)
 

webley

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

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

{quote}{login=Казанский}{date=01.08.2011 11:55}{thema=}{post}Может, кто-то периодически включает общий доступ к книге?{/post}{/quote}  

  нет, файл с макросом — это excel-отчет из корпоративной системы, т.е. он локальный
 

webley

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

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

И что интересно — дождался появления ошибки, ушел в отладку макроса и попробовал скопировать эти листы руками: Excel их просто не стал копировать… Ни ошибки, никаких сообщений — просто не копирует…
 

Строки длиннее 255 символов — кажется, в 2003 с этим была проблема?  

  Конфликт имен (одинаковые имена в разных книгах)?
 

nerv

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

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

мне кажется Казанский прав, может это — Конфликт имен?
 

webley

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

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

Про конфликт имен — не думаю, т.к. создаю новую книгу, и копирую листы с уже измененными названиями. Вообще какая-то мистика — перед запуском сохранил файл в корневой каталог на диск D, после этого все сработало. Сразу после выгрузки файл сохраняется здесь:  
C:Documents and SettingsaberkutovLocal SettingsTemporary Internet FilesSiebel25.07.11-31.07.11.xlsm  
Может быть тут собака порылась?  

  В любом случае, всем спасибо, попытаюсь выявить закономерность этой ошибки, а там видно будет…
 

БАХ43

Гость

#17

01.08.2011 22:15:23

А нет ли ограничения на размер локального профиля пользователя? Когда достигается предел, Excell не может хранить временный файл, просто негде. Соответственно не может скопировать лист, т.к. это ведет к увеличению размера временного файла. Попробуйте поменять пути на локальные диски в Параметрах Excell
Источник

Собрал макрос для работы с файлом, суть его в работе с листами файла и копированием данных с листов на основной лист.

При запуске через окно ВБА или по пути разраб-макросы-выполнить все отлично работает. Назначаю на кнопку — не работает. Чертовщина какая-то для меня.

   Public Sub HHHH()

    Dim LastRow, LastRow2, Lastcolumn, LastRow3, Lastcolumn2, LastRow4, Lastcolumn3 As Long
    Dim a As Long
    Dim Rw, Rw2, Rw3, Rw4, Rw5 As Long

    ThisWorkbook.Sheets("Неделя").Range("a17:y300") = ""
    a = ThisWorkbook.Sheets("Неделя").Cells(2, 2)
    LastRow = ThisWorkbook.Sheets("Банк").Cells(Rows.Count, 1).End(xlUp).Row
    LastRow2 = ThisWorkbook.Sheets("Поступления").Cells(Rows.Count, 1).End(xlUp).Row
    Lastcolumn = ThisWorkbook.Sheets("Поступления").Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow3 = ThisWorkbook.Sheets("Затраты").Cells(Rows.Count, 1).End(xlUp).Row
    Lastcolumn2 = ThisWorkbook.Sheets("Затраты").Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow4 = ThisWorkbook.Sheets("Счета").Cells(Rows.Count, 1).End(xlUp).Row
    Lastcolumn3 = ThisWorkbook.Sheets("Счета").Cells(1, Columns.Count).End(xlToLeft).Column
          Application.ScreenUpdating = False
           ThisWorkbook.Sheets("Банк").Activate
         With ThisWorkbook.Sheets("Неделя")
            Rw = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 1).End(xlUp).Row + 1
            For i = 1 To LastRow
                If Cells(i, 13) = a And Cells(i, 2) > 0 Then
                   ThisWorkbook.Sheets("Банк").Range(ThisWorkbook.Sheets("Банк").Cells(i, 1), ThisWorkbook.Sheets("Банк").Cells(i, 2)).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw, 1).PasteSpecial xlPasteValues
                   ThisWorkbook.Sheets("Банк").Range(ThisWorkbook.Sheets("Банк").Cells(i, 4), ThisWorkbook.Sheets("Банк").Cells(i, 5)).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw, 3).PasteSpecial xlPasteValues
                   ThisWorkbook.Sheets("Банк").Cells(i, 19).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw, 5).PasteSpecial xlPasteValues
                    Rw = Rw + 1
                End If
            Next
          End With
          With ThisWorkbook.Sheets("Неделя")
            Rw2 = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 11).End(xlUp).Row + 1
            For Z = 1 To LastRow
                If Cells(Z, 13) = a And Cells(Z, 3) > 0 Then
                   ThisWorkbook.Sheets("Банк").Cells(Z, 1).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw2, 11).PasteSpecial xlPasteValues
                   ThisWorkbook.Sheets("Банк").Range(ThisWorkbook.Sheets("Банк").Cells(Z, 3), ThisWorkbook.Sheets("Банк").Cells(Z, 5)).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw2, 12).PasteSpecial xlPasteValues
                   ThisWorkbook.Sheets("Банк").Cells(Z, 22).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw2, 15).PasteSpecial xlPasteValues
                    Rw2 = Rw2 + 1
                End If
            Next
           End With
           With ThisWorkbook.Sheets("Неделя")
             ThisWorkbook.Sheets("Поступления").Activate
            Rw3 = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 6).End(xlUp).Row + 1
            For in1 = 1 To Lastcolumn
                For in2 = 2 To LastRow2
                If Cells(1, in1) = a And Cells(in2, in1) > 0 Then
                   ThisWorkbook.Sheets("Поступления").Cells(in2, in1).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw3, 8).PasteSpecial xlPasteValues
                   ThisWorkbook.Sheets("Поступления").Range(ThisWorkbook.Sheets("Поступления").Cells(in2, 1), ThisWorkbook.Sheets("Поступления").Cells(in2, 2)).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw3, 6).PasteSpecial xlPasteValues
                    Rw3 = Rw3 + 1
                End If
                Next
            Next
          End With
          With ThisWorkbook.Sheets("Неделя")
                   ThisWorkbook.Sheets("Затраты").Activate
            Rw4 = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 18).End(xlUp).Row + 1
            For out1 = 1 To Lastcolumn2
                For out2 = 2 To LastRow3
                If Cells(1, out1) = a And Cells(out2, out1) > 0 Then
                   ThisWorkbook.Sheets("Затраты").Cells(out2, out1).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw4, 21).PasteSpecial xlPasteValues
                   ThisWorkbook.Sheets("Затраты").Cells(out2, 1).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw4, 18).PasteSpecial xlPasteValues
                   ThisWorkbook.Sheets("Затраты").Cells(out2, 3).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw4, 20).PasteSpecial xlPasteValues
                    Rw4 = Rw4 + 1
                End If
                Next
            Next
             End With
          With ThisWorkbook.Sheets("Неделя")
                   ThisWorkbook.Sheets("Счета").Activate
            Rw5 = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 24).End(xlUp).Row + 1
            For bill1 = 1 To Lastcolumn2
                For bill2 = 2 To LastRow3
                If Cells(1, bill1) = a And Cells(bill2, bill1) > 0 Then
                   ThisWorkbook.Sheets("Счета").Cells(bill2, bill1).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw5, 25).PasteSpecial xlPasteValues
                   ThisWorkbook.Sheets("Счета").Cells(bill2, 2).Copy
                   ThisWorkbook.Sheets("Неделя").Cells(Rw5, 24).PasteSpecial xlPasteValues

                    Rw5 = Rw5 + 1
                End If
                Next
            Next
        End With

     ThisWorkbook.Sheets("Неделя").Activate
     Application.ScreenUpdating = True
    End Sub

Помогите плиз решить головоломку.

P.s. нашел странность — после выполнения макроса, остаются данные которые недокопировались с последней операции if. Может, неправильно данные сохраняются в хранилище данных?
P.s.2. — добавил картинку схемы работы макроса в программе.

Схема

Источник

Студворк — интернет-сервис помощи студентам

Добрый день, уважаемые форумчане!

Возникла следующая проблема: делаю копирование данных из одной книги в другую следующим образом:
book.Sheets(1).Range(book.Sheets(1).Cells(2, Fields(i)), book.Sheets(1).Cells(LastLoadRow, Fields(i))).Copy
ActiveWorkbook.Sheets(1).Cells(CurRow, i).Select
ActiveWorkbook.Sheets(1).Paste

При копировании вручную диапазона все проходит прекрасно, но при копировании программно в части ячеек тупо теряется форматирование (бордер, цвет). Происходит это только с ячейками, не содержащими значений!
Пробовал копировать с помощью PasteSpecial с параметром xlPasteValues — та же самая история: теряется форматирование той же части ячеек.
Характерно, что если скопировать формат после копирования значений или полного копирования ячеек, та часть, что потеряла бордеры, их восстанавливает, и наоборот.
Пробовал делать PasteSpecial с параметром игнорирования пустых ячеек — не помогает.
Приложил две картинки. На них видно исходное форматирование и форматирование после копирования.

Перепробовал массу вариантов копирования данных, удалял «кривые позиции» и в источнике и в приемнике, выбирал разное форматирование. Всегда тот же затык. Теперь даже не знаю в каком направлении рыть… Может кто сталкивался с подобным?

Источник

#excel #vba

#excel #vba

Вопрос:

У меня возникли проблемы с отладкой моего кода vba. Цель макроса — взять лист из текущей книги и сохранить его как определенный CSV-файл. Этот код работал нормально, пока я не получил новый компьютер с Catalina (10.15.4). Ошибка возникает в pasteRange.Value = copyRange.Value , а код ошибки VBA: Method 'Value' of object 'Range' failed (Run-time error '1004') . Поэтому, когда он выдает ошибку, файл MasterLoad.csv открыт, но исходные данные просто не могут быть скопированы.

 Sub SheetToCSV()
    Application.ScreenUpdating = False:  Application.EnableEvents = False:  Application.DisplayAlerts = False
'    On Error GoTo Cleanup

    Dim strSourceSheet As String
    Dim strFullname As String
    Dim fileAccessGranted As Boolean
    Dim filePermissionCandidates
    Dim copyWB As Workbook
    Dim pasteWB As Workbook
    Dim copyRange As Range
    Dim pasteRange As Range
    
    Set copyWB = ThisWorkbook

    ' set variables for sheet name and file path
    strSourceSheet = "MasterLoad"
    strFullname = "/Users/mypath/MasterLoad.csv"
    
    ' grant permission for VBA to open/save MasterLoad file
    filePermissionCandidates = Array(strFullname)
    grantFileAccess (filePermissionCandidates)
    
    ' set copy range
    Set copyRange = copyWB.Sheets(strSourceSheet).Range("A1:ZZ2000")
    
    ' open paste WB, set paste range, set values, and save
    Set pasteWB = Workbooks.Open(strFullname)
    Set pasteRange = pasteWB.Sheets(1).Range("A1:ZZ2000")
    pasteRange.Value = copyRange.Value
    pasteWB.SaveAs FileName:=strFullname, _
                          FileFormat:=xlCSV
    pasteWB.Close SaveChanges:=True 'close wb and save
    
    Application.ScreenUpdating = True:  Application.EnableEvents = True: Application.DisplayAlerts = True
End Sub


Function grantFileAccess(filePermissionCandidates)
  grantFileAccess = GrantAccessToMultipleFiles(filePermissionCandidates) 'returns true if access granted, false otherwise_
End Function

Я не уверен, действительно ли это проблема с ОС, потому что у меня практически тот же код в другой книге, и он отлично работал с новым компьютером, но больше ничего не изменилось, кроме получения нового компьютера с помощью этого макроса. Есть мысли?

Комментарии:

1. Application.DisplayAlerts = False может скрывать некоторую полезную информацию, поэтому удалите.

2. Спасибо за предложение — ошибка заключалась в том, что диапазон был слишком большим для моей памяти. Удивительно, что он не смог обработать A1: ZZ2000, поскольку это было возможно на моем MacBook Pro 2015 года, но изменение его на A1: JZ2000 сработало.

Ответ №1:

На всякий случай поставьте точку останова в строке

 pasteRange.Value = copyRange.Value

и убедитесь, что оба диапазона четко определены.

У меня была аналогичная проблема при копировании и вставке целого столбца, иногда это не удавалось с VBA: Method 'Insert' of object 'Range' failed (Run-time error '1004') без видимой причины, и Excel полностью ломался, и его приходилось перезапускать. Я почти уверен, что это ошибка в Excel.

Комментарии:

1. Спасибо за комментарий — я отключил Application.DisplayAlerts = False , как предлагалось выше, и оказалось, что у меня недостаточно памяти. Что было для меня неожиданностью, поскольку A1: ZZ2000 работал на моем старом компьютере. Но A1: JZ2000 теперь работает.

Ответ №2:

Как было предложено @ComputerVersteher, я удалил Application.DisplaysAlerts = False и получил сообщение об ошибке, в котором говорилось, что у меня недостаточно памяти для завершения операции. Я изменил диапазон копирования / вставки на A1: JZ2000, и это сработало, но я все еще не понимаю, почему диапазон A1: ZZ2000 не будет работать на моем более новом / лучшем компьютере.

Источник

Понравилась статья? Поделить с друзьями:
  • Vba ошибка переполнения
  • Vba ошибка runtime error 6 overflow
  • Vba ошибка runtime error 1004
  • Vba ошибка 80004005
  • Vba ошибка 5174