Помогите доработать этот макрос, что б он сохранял листы в новую книгу, а не в текущую.
Код
Sub qwe()
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim i As Integer, lr As Integer
Set ws1 = ThisWorkbook.Worksheets("ТТ")
Set ws2 = ThisWorkbook.Worksheets("МСК")
Set ws3 = ThisWorkbook.Worksheets("Back")
lr = ws1.Cells(Rows.Count, 4).End(xlUp).Row
With ws2
For i = 10 To lr
If ws1.Cells(i, 1) <> "" Then
ws2.Copy , Worksheets(Worksheets.Count)
wsC = Sheets.Count
Sheets(wsC).Name = ws1.Cells(i, 2)
Sheets(wsC).Cells(6, 43) = ws1.Cells(2, 16)
Sheets(wsC).Cells(6, 1) = ws1.Cells(i, 6)
Sheets(wsC).Cells(10, 1) = ws1.Cells(i, 14)
Sheets(wsC).Cells(6, 23) = ws1.Cells(4, 16)
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
tsutse написал: сообщения на 2 странице обычно уже никто не читает
Ваше сообщение ещё на первой странице. А ответить на вопрос - элементарная вежливость. И вообще нужно отписываться в своих темах. Последнее сообщение должно быть Вашим. Люди тратят своё время на помощь Вам, а Вам трудно потратить минуту?
Немного подправил, только не получается копировать лист в созданную книгу....
Код
Sub qwe()
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim i As Integer, lr As Integer, w As String
Set ws1 = ThisWorkbook.Worksheets("ТТ")
Set ws2 = ThisWorkbook.Worksheets("МСК")
Set ws3 = ThisWorkbook.Worksheets("Back")
w = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
Workbooks.Add (1)
With ActiveWorkbook
.SaveAs Filename:=ThisWorkbook.Path & "\МСК " & w & ".xls"
'.Close True
End With
lr = ws1.Cells(Rows.Count, 4).End(xlUp).Row
With ws2
For i = 9 To lr
If ws1.Cells(i, 2) <> "" Then
ws2.Copy , after:=ActiveWorkbook.Sheets(1) 'Вот в этом месте не пойму как правильно копировать лист
wsC = Sheets.Count
Sheets(wsC).Name = ws1.Cells(i, 2)
Sheets(wsC).Cells(6, 43) = ws1.Cells(2, 16)
Sheets(wsC).Cells(6, 1) = ws1.Cells(i, 6)
Sheets(wsC).Cells(10, 1) = ws1.Cells(i, 14)
Sheets(wsC).Cells(6, 23) = ws1.Cells(4, 16)
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Итак, начнем с начала, Вы хотите сохранять листы, в коде же всего один лист копируется, отсюда вопросы. Как должно все выглядеть в итоге? Какие листы нужно переносить? В одну книгу или в разные?
"Все гениальное просто, а все простое гениально!!!"
Вот этот код переносит листы в другую книгу сохраняет ее и закрывает
Код
Sub test()
Dim sht, book As Workbook
Dim arr(), iPath$
iPath = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
iPath = ThisWorkbook.Path & "\МСК " & iPath & ".xls"
arr = Array("TT", "МСК", "Back")
Set book = Workbooks.Add(1)
book.SaveAs Filename:=iPath
For Each sht In arr
With ThisWorkbook.Worksheets(sht)
.Copy after:=book.Worksheets(book.Sheets.Count)
'какое-то копирование
End With
Next sht
book.Close True
End Sub
"Все гениальное просто, а все простое гениально!!!"
По кнопке создается книга, макрос бежит по определенному столбцу и ищет непустые строки, когда он находит первую непустую строку - копируется лист "МСК" в новую книгу, заполняется значениями из начальной таблицы, потом ищет след. непустую строку и так далее, наполняя заполненными бланками новую книгу.
Я Вам показал код, полностью соответствующий названию темы и вопросу и самого первого сообщения, там ни о каких данных и "бегущих" макросах речи не было .
Цитата
tsutse написал:Помогите доработать этот макрос, что б он сохранял листы в новую книгу, а не в текущую.
"Все гениальное просто, а все простое гениально!!!"