Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
при копировании возникает ошибка очистки буфера обмена
 
Помогите с назойливым сообщением - при банальном копировании или переносе ячеек в Excel возникает ошибка очистки буфера обмена, причём не всегда. При нажатии кнопки "ок" данные вставляются без проблем. Получается - на работу влияет только замедлением этой самой работы.    
Подскажите, кто знает, как от неё избавиться?
Копирование данных в другую книгу с накоплением
 
Прошу не ругать меня за "замусоленную" тему, но 2 часа мучил поиск - подходящего решения не нашёл. (Сам видел похожее решение пару месяцев назад, а сейчас найти не могу)  
Короче есть 2 файла (прилагаю)  
В первом ("график")пользователем вносятся данные:  
1)период (ячейка А1)  
2)часы работы (ячейки L2:M25)  
данные заполняются раз в неделю  
После чего пользователь запускает макрос который открыв второй файл "общие часы" сравнил последнюю заполненную ячейку в строке 1 (последний период (N1)) с А1 файла "график" , и если данные те же, то по принципу ВПР вставил данные (только значения) в ячейках ниже.  
Если ячейки А1 в "график" и последняя незаполненная в 1-й строке не совпадают, то в следующей (незаполненной) ячейке первой строки вставить значения из А1 в файле "график"  
и соответственно в ячейках ниже принципу ВПР.  
Почему по принципу ВПР - Фамилии могут меняться местами или пропадать.  
В файле "график" есть кусочек примерного кода, но буду очень рад за помощь в построении условий
Цикл в макросе, и другая петрушка
 
Взываю к помощи, потому как знаний нехватает!  
Предлагаю код, в примечаниях написал где у меня не получается:  
 
Sub Создание()  
'  
   Sheets("Список товара").Select  
   Application.DisplayAlerts = False  
' !проверяет, если ячейка Q3 <>0, то копирует значения из диапазона Q3:AD3 в Q1:AD1  
' !затем надо чтобы проверял значение в Q4 и копировал в Q1:AD1, и т.д.  
   x = 3  
   Do While Cells(x, 17).Value <> 0  
   Range("x,17 : x,30").Select  
   Selection.Copy  
   Range("Q1").Select  
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
' !это неработает надо исправлять  
   Sheets("Список товара").Select  
   Sheets("Лист1").Select  
' !надо заставить фильтровать по значению из ячейки "А1"  
   ActiveSheet.Range("$B$1:$N$872").AutoFilter Field:=1, Criteria1:= _  
       ("A1"), Operator:=xlAnd  
   Range("D2:D873").Select  
   Application.CutCopyMode = False  
   Selection.Copy  
   Sheets("Список товара").Select  
   Range("B3").Select  
   Selection.SpecialCells(xlCellTypeVisible).Select  
   Sheets("Лист1").Select  
   Application.CutCopyMode = False  
   Selection.Copy  
   Selection.SpecialCells(xlCellTypeVisible).Select  
   Application.CutCopyMode = False  
   Selection.Copy  
   Application.CutCopyMode = False  
   Selection.Copy  
   Sheets("Список товара").Select  
   Range("B3").Select  
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
   Sheets("Бланк отчёта").Select  
   Range("B9:C9").Select  
   Sheets("Бланк отчёта").Select  
   Application.CutCopyMode = False  
   Sheets("Бланк отчёта").Copy  
   Dim strDate As String  
   strDate = Range("A1")  
   ActiveWorkbook.SaveAs Filename:= _  
       "C:\Documents and Settings\my\Desktop\" + strDate + ".xls", FileFormat:=xlExcel8, _  
       Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _  
       CreateBackup:=False  
   iLinks = ActiveWorkbook.LinkSources(xlExcelLinks)  
   If Not IsEmpty(iLinks) Then  
   For i = LBound(iLinks) To UBound(iLinks)  
   ActiveWorkbook.BreakLink Name:=iLinks(i), Type:=xlExcelLinks  
   Next i  
   End If  
   ActiveWorkbook.Save  
   ActiveWindow.Close  
   Sheets("Список товара").Select  
   x = x + 1  
   Loop  
   Application.DisplayAlerts = True  
End Sub
Страницы: 1
Наверх