Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Непонятный, но полезый макрос... / 6 сообщений из 6, страница 1 из 1
24.05.2007, 10:38:14
    #34547728
GhostProgram
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Непонятный, но полезый макрос...
Добрый день! В книге Била Джелена нашел макрос, который из всех рабочих книг, находящихся в одной папке, копирует все листы в одну книгу. Основные действия в макросе понятны, но хотелось немного его подкорректировать сам макрос и прояснить некоторые непонятные вещи:

Sub CombineWorkbooks()
Dim CurFile As String
Dim DestWB As Workbook
Dim ws As Object
Const DirLoc As String = "C:\Data\" ' путь к папке с файлами
Application.ScreenUpdating = False '
Set DestWB = Workbooks.Add(xlWorksheet) '
CurFile = Dir(DirLoc & "*.xls")
Do While CurFile <> vbNullString
Dim OrigWB As Workbook
Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True) 'открываем каждый файл
CurFile = Left(Left(CurFile, Len(CurFile) - 3), 30)
For Each ws In OrigWB.Sheets
ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
If OrigWB.Sheets.Count > 1 Then
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
Else
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
End If
Next
OrigWB.Close SaveChanges:=False
CurFile = Dir
Loop
Application.DisplayAlerts = False
DestWB.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set DestWB = Nothing
End Sub

1.Макрос копирует рабочие листы в новую рабочую книгу, а как сделать так чтобы копировал в книгу в которой кнопка по исполнению макроса?
2.Из каждой книги мне нужно допустим удалить Лист1 я вставляю в цикл

For Each ws In OrigWB.Sheets
ws.Activate
ws.Worksheets("Лист1").Delete
ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
If OrigWB.Sheets.Count > 1 Then
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
Else
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
End If
Next
а прога ругается...Подскажите пожалуйста, как мне корректно в цикле записать обращение к каждому листу1 для удаления...
...
Рейтинг: 0 / 0
24.05.2007, 10:51:02
    #34547787
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Непонятный, но полезый макрос...
GhostProgram
1.Макрос копирует рабочие листы в новую рабочую книгу, а как сделать так чтобы копировал в книгу в которой кнопка по исполнению макроса?

замени
Код: plaintext
Set DestWB = Workbooks.Add(xlWorksheet) 
на
Код: plaintext
Set DestWB = ThisWorkbook
...
Рейтинг: 0 / 0
24.05.2007, 10:57:18
    #34547822
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Непонятный, но полезый макрос...
GhostProgram
2.Из каждой книги мне нужно допустим удалить Лист1 я вставляю в цикл

For Each ws In OrigWB.Sheets
ws.Activate
ws.Worksheets("Лист1").Delete
ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
If OrigWB.Sheets.Count > 1 Then
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
Else
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
End If
Next
а прога ругается...Подскажите пожалуйста, как мне корректно в цикле записать обращение к каждому листу1 для удаления...

перед
Код: plaintext
For Each ws In OrigWB.Sheets
поставь
Код: plaintext
OrigWB.Worksheets("Лист1").Delete
...
Рейтинг: 0 / 0
24.05.2007, 11:36:41
    #34548026
GhostProgram
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Непонятный, но полезый макрос...
А как мне можно копировать только "нужные" листы из рабочих книг? Например скопировать листы2?

For Each ws In OrigWB.Sheets("Лист2")
ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
If OrigWB.Sheets.Count > 1 Then
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
Else
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
End If
или так не идет:


For Each WorkSheets("Лист2") In OrigWB.Sheets
ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
If OrigWB.Sheets.Count > 1 Then
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
Else
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
End

Синтаксис такой запутанный, не могу понять...
...
Рейтинг: 0 / 0
25.05.2007, 09:27:14
    #34550257
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Непонятный, но полезый макрос...
...
Рейтинг: 0 / 0
25.05.2007, 09:47:10
    #34550315
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Непонятный, но полезый макрос...
GhostProgramА как мне можно копировать только "нужные" листы из рабочих книг? Например скопировать листы2?

Код: plaintext
1.
2.
3.
4.
5.
6.
For Each ws In OrigWB.Sheets("Лист2")
              ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
      If OrigWB.Sheets.Count >  1  Then
         DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
      Else
         DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
      End If
или так не идет:


Код: plaintext
1.
2.
3.
4.
5.
6.
For Each WorkSheets("Лист2") In OrigWB.Sheets
              ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
      If OrigWB.Sheets.Count >  1  Then
         DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
      Else
         DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
      End 

Синтаксис такой запутанный, не могу понять...

кнопка SRC сверху делает прекрасный вид поста


Код: plaintext
1.
2.
3.
4.
5.
6.
Dim sh As Worksheet
On Error Resume Next 'откладываем ошибку
Set sh = OrigWB.Sheets("Лист2") 'устанавливаем ссылку на лист
If Not sh Is Nothing Then 'проверяем если листа нет то ссылка будет Nothing
    sh.Copy After:=DestWB.Sheets(DestWB.Sheets.Count) 'копируем
End If
On Error GoTo  0 
' можно конечно и бегать по всем листам книги, сравнивая имя (но так не делают)
Код: plaintext
1.
2.
For Each ws In OrigWB.Sheets
    If ws.Name = "Лист2" Then ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
Next
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Непонятный, но полезый макрос... / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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