Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Run-time error 1004: Метод Paste из класса Worksheet завершен неверно., Ошибка. Метод Paste из класса Worksheet завершен неверно.
 
Собственно, пока код не модернизировал все работало. Теперь сделал корректный выбор только 1 файла, но не вставляются данные.

Вроде все делаю самым простым способом. Просто копирую из одного листа и вставляю в другой. Почему же возникает такая ошибка?

Запустить:
Запустить файл Приготовить таблицу КДР. Нажать кнопку получить данные.
Выбрать файл Отчет Список обучающихся очно в X параллели(входящие данные)

И будет эта самая ошибка
 
Цитата
extrafant написал: И будет эта самая ошибка
Ошибка не воспроизвелась.
На какой строке какого макроса ошибка?
Согласие есть продукт при полном непротивлении сторон.
 
Private Sub pastedata()
   ThisWorkbook.Activate
   shData.Select
   ActiveSheet.Cells.Clear
   Range("A1").Select
   ActiveSheet.Paste
End Sub

Во время  ActiveSheet.Paste

Это самое paste не происходит
 
Замените ВЕСЬ ваш код. Ему припарками не помочь.
Будет и открываться, как надо, и вставляться, и заменяться.
Код
Private Sub openfile()
    Dim filename$, cl As Range
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .AllowMultiSelect = True
        .Title = "Please select the folder containing the files you want to Import"

        If .Show = -1 Then
            filename = .SelectedItems(1)
        End If
    End With
    If filename = Empty Then End
    Application.ScreenUpdating = False
    With Workbooks.Open(filename)
        shData.UsedRange.Clear
        .Sheets(1).Range("A8").CurrentRegion.Copy shData.Cells(1)
        .Close savechanges:=False
    End With
    On Error Resume Next
    shData.Cells.WrapText = False
    shData.Columns(3).AutoFit
    For Each cl In Intersect(shData.UsedRange, shData.Columns(3))
        cl.Value = Left(cl.Value, InStrRev(cl.Value, " ") - 1)
    Next
    Application.ScreenUpdating = True
End Sub 
 
Ошибка сохранилась. Хотя я заменил содержимое макроса Private Sub openfile()
 
Цитата
Sanja написал:
Ошибка не воспроизвелась.На какой строке какого макроса ошибка?
Странно, конечно, что у Вас ошибка не воспроизводится
 
По ошибке. Строка
 
Код
 ActiveSheet.Cells.Clear

сбрасывает буфер, и вставлять нечего.
 
Цитата
RAN написал:
По ошибке. Строка   Код ? 1ActiveSheet.Cells.Clearсбрасывает буфер, и вставлять нечего.
Закомментил. Ошибка сохранилась.
Изменено: extrafant - 11 Июл 2019 12:58:16
 
Цитата
extrafant написал:
Хотя я заменил содержимое макроса Private Sub openfile()
Если это реакция на мой ответ, то весь код, и текст одной процедуры - вещи разные.
Запускайте сразу openfile.
 
Цитата
RAN написал:
Если это реакция на мой ответ, то весь код, и текст одной процедуры - вещи разные.Запускайте сразу openfile.
Я разобрался. Ошибки нет.

Когда я скопировал Ваш код, то я забыл добавить вот этот участок кода:
Код
If filename = Empty Then End
    Workbooks.Open (filename)
    Range("A8").Select
    ActiveCell.CurrentRegion.Select
    ActiveCell.CurrentRegion.Copy
    
    Application.DisplayAlerts = False
    
    Workbooks(filename).Close savechanges:=False
    
    Application.DisplayAlerts = True

Соответственно ничего не копировалось и вставиться уже ничего не могло.

СПАСИБО!

 
Цитата
extrafant написал:
то я забыл добавить вот этот участок кода:
Что значит "забыл"? И зачем в мой код вообще что-либо добавлять? Тем паче эдакое?
 
Цитата
RAN написал:
Замените ВЕСЬ ваш код. Ему припарками не помочь.Будет и открываться, как надо, и вставляться, и заменяться.Код ? 1234567891011121314151617181920212223242526Private Sub openfile()    Dim filename$, cl As Range    With Application.FileDialog(msoFileDialogFilePicker)        .InitialFileName = ThisWorkbook.Path & "\"        .AllowMultiSelect = True        .Title = "Please select the folder containing the files you want to Import"         If .Show = -1 Then            filename = .SelectedItems(1)        End If    End With    If filename = Empty Then End    Application.ScreenUpdating = False    With Workbooks.Open(filename)        shData.UsedRange.Clear        .Sheets(1).Range("A8").CurrentRegion.Copy shData.Cells(1)        .Close savechanges:=False    End With    On Error Resume Next    shData.Cells.WrapText = False    shData.Columns(3).AutoFit    For Each cl In Intersect(shData.UsedRange, shData.Columns(3))        cl.Value = Left(cl.Value, InStrRev(cl.Value, " ") - 1)    Next    Application.ScreenUpdating = TrueEnd Sub

Данный участок работал.
Но не работал для моих нужд.
Как только я добавил:
Код
If filename = Empty Then End
    Workbooks.Open (filename)
    Range("A8").Select
    ActiveCell.CurrentRegion.Select
    ActiveCell.CurrentRegion.Copy
    Application.DisplayAlerts = False
    Workbooks(filename).Close savechanges:=False
    Application.DisplayAlerts = True

сразу ошибка, которая не вставляла данные ушла. И все заработало


Понятно, что вставить оно не могло т.к. не было  ActiveCell.CurrentRegion.Copy
Страницы: 1
Читают тему (гостей: 1)
Наверх