ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / проблема с копированием листов Excel
3 сообщений из 3, страница 1 из 1
проблема с копированием листов Excel
    #33100366
Antonio1
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Antonio1
Участник
нужно макросом скопировать частично информацию из 2-х листов в листы новой книги
использую макросы, вываливается ексель в ошибку с предложением отправить отчет в Майкрософт :(
Win XP(2000), Офис ХР - пробовал на 3-х машинах
код

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
 Dim xlApp As Object

Sub CopySheet1()
    
   Worksheets( 1 ).Activate
    If Worksheets( 1 ).AutoFilterMode Then
        Worksheets( 1 ).AutoFilterMode = False
    End If
    Rows("13:13").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:= 3 , Criteria1:=Cells( 9 ,  11 ).Value
    
    'определяем конечную строку
    k =  14 
    For i = k To  65535 
        If Cells(i,  11 ).Value =  0  And Cells(i,  12 ) =  0  Then
            Exit For
        End If
    Next i
    
    Worksheets( 1 ).Range(Cells(k -  1 ,  1 ), Cells(i -  1 ,  17 )).Copy
    xlApp.Application.Worksheets( 1 ).Paste (xlApp.Application.Worksheets( 1 ).Rows("1:65535"))
    
    xlApp.Application.Worksheets( 1 ).Columns("E:F").Delete
    xlApp.Application.Worksheets( 1 ).Name = "БН"
End Sub

Sub CopySheet2()
   'форма 2
    Worksheets( 2 ).Activate
    If Worksheets( 2 ).AutoFilterMode Then
        Worksheets( 2 ).AutoFilterMode = False
    End If
    Rows("13:13").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:= 3 , Criteria1:=Worksheets( 1 ).Cells( 9 ,  11 ).Value
    
    k =  14 
    For i = k To  65535 
        If Cells(i,  10 ).Value =  0  And Cells(i,  11 ) =  0  Then
            Exit For
        End If
    Next i
    
    Range(Cells(k -  1 ,  1 ), Cells(i -  1 ,  16 )).Copy
    xlApp.Application.Worksheets( 2 ).Paste (xlApp.Application.Worksheets( 2 ).Rows("1:65535"))
    
    xlApp.Application.Worksheets( 2 ).Columns("E:G").Delete
    xlApp.Application.Worksheets( 2 ).Name = "Нал"
End Sub

Sub RunAll()
    Set xlApp = CreateObject("excel.application")
    xlApp.Visible = True
    xlApp.Workbooks.Add
    CopySheet1
    CopySheet2
End Sub

Вначале всебыло одной процедурой, потом разделил на 2.
Если запускать по одной - обе (по раздельности) отрабатывают отлично
если две подряд - вываливается с закрытием ексель
где я ошибся, подскажите плиз
...
Рейтинг: 0 / 0
03.06.2005, 16:55:21
| Ответить | Цитировать | Написать  
проблема с копированием листов Excel
    #33100737
White Owl
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
White Owl
Участник
Нахрена из экселя открывать другой эксель через ОЛЕ????
А ошибся ты намного раньше - когда выбирал себе такой учебник по VBA :)
На, думай:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
sub aaaa()
   Dim ws as WorkSheet, wbNew as WorkBook, wd as Worksheet
   Dim iWorkSheetNumber as Integer
   Dim iFirstRow as Integer, iLastRow as Integer

   set wbNew = Application.Workbooks.Add
   ' один лист в книге есть сразу, добавляем второй
   wbNew.Worksheets.Add

   for iWorkSheetNumber =  1  to  2 
      Set ws = ThisWorkbook.Worksheets(iWorkSheetNumber)
      Set wd = wbNew.Worksheets(iWorkSheetNumber)

      if ws.AutoFilterMode then
           ws.AutoFilterMode = false
      end if
      ws.Rows( 13 ).AutoFilter Field:= 3 , Criteria:= ThisWorkbook.Worksheets( 1 ).Cells( 9 , 11 ).Value

      ' определяем конечную строку
      iFirstRow =  14 
      iLastRow = iFirstRow
      while (ws.Cells(iLastRow,  11 ).Value <>  0 ) or (ws.Cells(iLastRow,  12 ).Value <>  0 )
             iLastRow = iLastRow +  1 
      wend

      if iWorkSheetNumber =  1  then
         ws.Range(ws.Cells(iFirstRow -  1 ,  1 ), ws.Cells(iLastRow,  17 )).Copy
      else
         ws.Range(ws.Cells(iFirstRow -  1 ,  1 ), ws.Cells(iLastRow,  16 )).Copy
      end if
      wd.Paste wd.Range("A1")

      if iWorkSheetNumber =  1  then
          wd.Columns("E:F").Delete
          wd.Name = "БН"
      else
          wd.Columns("E:П").Delete
          wd.Name = "Нал"
      end if
   next
end sub
...
Рейтинг: 0 / 0
03.06.2005, 20:04:10
| Ответить | Цитировать | Написать  
проблема с копированием листов Excel
    #33102203
Antonio1
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Antonio1
Участник
учусь по хелпам, учебника нет...
...
Рейтинг: 0 / 0
06.06.2005, 11:29:07
| Ответить | Цитировать | Написать  
3 сообщений из 3, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / проблема с копированием листов Excel
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=33100737&tid=2186011]:
 0ms
get settings:
 7ms
get forum list:
 9ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 22ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 43ms
get tp. blocked users:
 1ms
others: 224ms
total:  321ms
созд. / загр.: 321ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]