У меня имеется файл из которого мне необходимо скопировать некоторые столбцы в новую созданную книгу.
Данный код нашел в интернете, не могу в нем сделать новую книгу активной чтобы в ней работать, например как вставить данные из буфера обмена, т.к. активной книгой остается та из которой копирую столбцы
Помогите, пожалуйста. (В VBA я новичок)
[vba]
Код
Public Sub nytfjdkt()
'-----Копирование столбцов из старой книги в новую книгу---------- Range("A:H,S:S,U:U,W:W,AQ:AQ,AE:AE,AF:AF,AY:AY,BA:BA,BG:BG,BH:BH,BI:BI").Select ' Range( _ "Таблица_beta_newbooksql_Rebus_vwDefect[[#Headers],[Сумма дельта приходная, руб.]]" _ ).Activate Selection.Copy '------------СОЗДАНИЕ НОВОЙ КНИГИ---------------
Dim oExcel As New Excel.Application 'Запускаем Excel oExcel.Visible = True 'Делаем его видимым Dim oWbk As Excel.Workbook 'Создаем новую книгу Книга1 Set oWbk = oExcel.Workbooks.Add() Dim oSheet As Excel.Worksheet Set oSheet = oWbk.Worksheets.Item("Лист1") 'Находим Лист1 oSheet.Name = "Новый лист" 'Присваиваем ему имя "Новый лист" Dim oRange As Range 'Находим диапазон A1 в Книга1 Set oRange = oSheet.Range("A1")
'----------На данном этапе я хочу вставить данные из буфера
oRange.Value = "Начиная с этой ячейки я хочу вставить диапазон из буфера" 'вносим в него данные
End Sub
[/vba]
[moder]Читаем внимательно правила форума Особенно п.п.3[/moder]
Добрый день!
У меня имеется файл из которого мне необходимо скопировать некоторые столбцы в новую созданную книгу.
Данный код нашел в интернете, не могу в нем сделать новую книгу активной чтобы в ней работать, например как вставить данные из буфера обмена, т.к. активной книгой остается та из которой копирую столбцы
Помогите, пожалуйста. (В VBA я новичок)
[vba]
Код
Public Sub nytfjdkt()
'-----Копирование столбцов из старой книги в новую книгу---------- Range("A:H,S:S,U:U,W:W,AQ:AQ,AE:AE,AF:AF,AY:AY,BA:BA,BG:BG,BH:BH,BI:BI").Select ' Range( _ "Таблица_beta_newbooksql_Rebus_vwDefect[[#Headers],[Сумма дельта приходная, руб.]]" _ ).Activate Selection.Copy '------------СОЗДАНИЕ НОВОЙ КНИГИ---------------
Dim oExcel As New Excel.Application 'Запускаем Excel oExcel.Visible = True 'Делаем его видимым Dim oWbk As Excel.Workbook 'Создаем новую книгу Книга1 Set oWbk = oExcel.Workbooks.Add() Dim oSheet As Excel.Worksheet Set oSheet = oWbk.Worksheets.Item("Лист1") 'Находим Лист1 oSheet.Name = "Новый лист" 'Присваиваем ему имя "Новый лист" Dim oRange As Range 'Находим диапазон A1 в Книга1 Set oRange = oSheet.Range("A1")
'----------На данном этапе я хочу вставить данные из буфера
oRange.Value = "Начиная с этой ячейки я хочу вставить диапазон из буфера" 'вносим в него данные
End Sub
[/vba]
[moder]Читаем внимательно правила форума Особенно п.п.3[/moder]Дмитрий_С
Сообщение отредактировал DJ_Marker_MC - Среда, 14.01.2015, 12:31
В новый эксель вставить скопированные столбцы будет проблематично - вставляйте в тот же эксель. Т.е. Ваш код почти полностью не годится, нужно переписывать.
В новый эксель вставить скопированные столбцы будет проблематично - вставляйте в тот же эксель. Т.е. Ваш код почти полностью не годится, нужно переписывать.Hugo
Public Sub nytfjdkt() Dim oWbk As Excel.Workbook Dim oSheet As Excel.Worksheet Dim Sh As Excel.Worksheet Set Sh = ActiveSheet Set oWbk = Workbooks.Add() Set oSheet = oWbk.Worksheets("Лист1") 'Находим Лист1 oSheet.Name = "Новый лист" 'Присваиваем ему имя "Новый лист" '-----Копирование столбцов из старой книги в новую книгу---------- Sh.Range("A:H").Copy oSheet.Range("A1") End Sub
[/vba]
[vba]
Код
Public Sub nytfjdkt() Dim oWbk As Excel.Workbook Dim oSheet As Excel.Worksheet Dim Sh As Excel.Worksheet Set Sh = ActiveSheet Set oWbk = Workbooks.Add() Set oSheet = oWbk.Worksheets("Лист1") 'Находим Лист1 oSheet.Name = "Новый лист" 'Присваиваем ему имя "Новый лист" '-----Копирование столбцов из старой книги в новую книгу---------- Sh.Range("A:H").Copy oSheet.Range("A1") End Sub
Вставлю свои 5 копеек. Для создания новой книги новый Excel не нужен. И в буфер обмена через Selection.Copy - тоже не наш метод. Наш метод - как у alex77755. Я его дополнительно раскрасил множественными областями: [vba]
Код
Sub copy2()
Dim oSheet As Worksheet Dim srcRange As Range Dim area As Range
Set srcRange = Intersect(ActiveSheet.UsedRange, _ Range("A:H,S:S,U:U,W:W,AQ:AQ,AE:AE,AF:AF,AY:AY,BA:BA,BG:BG,BH:BH,BI:BI"))
Set oSheet = Workbooks.Add.Worksheets("Лист1") 'Создаем новую книгу и находим Лист1 oSheet.Name = "Новый лист" 'Присваиваем ему имя "Новый лист"
For Each area In srcRange.Areas area.Copy oSheet.Range(area.Address) Next
End Sub
[/vba]
Вставлю свои 5 копеек. Для создания новой книги новый Excel не нужен. И в буфер обмена через Selection.Copy - тоже не наш метод. Наш метод - как у alex77755. Я его дополнительно раскрасил множественными областями: [vba]
Код
Sub copy2()
Dim oSheet As Worksheet Dim srcRange As Range Dim area As Range
Set srcRange = Intersect(ActiveSheet.UsedRange, _ Range("A:H,S:S,U:U,W:W,AQ:AQ,AE:AE,AF:AF,AY:AY,BA:BA,BG:BG,BH:BH,BI:BI"))
Set oSheet = Workbooks.Add.Worksheets("Лист1") 'Создаем новую книгу и находим Лист1 oSheet.Name = "Новый лист" 'Присваиваем ему имя "Новый лист"
For Each area In srcRange.Areas area.Copy oSheet.Range(area.Address) Next
Я его дополнительно раскрасил множественными областями:
Красиво раскрасил, но оказалось достаточным кода у alex77755)
Друзья, огромное спасибо за помощь! Я недели две блуждал в интернете и не мог найти подходящий код, все остальные не подходили, а ошибку в них я не мог найти. Данный код это именно то, что мне надо. Всё работает!
Я его дополнительно раскрасил множественными областями:
Красиво раскрасил, но оказалось достаточным кода у alex77755)
Друзья, огромное спасибо за помощь! Я недели две блуждал в интернете и не мог найти подходящий код, все остальные не подходили, а ошибку в них я не мог найти. Данный код это именно то, что мне надо. Всё работает! Дмитрий_С
Sub tt() Dim r As Range '-----Копирование столбцов из старой книги в новую книгу---------- Set r = ActiveSheet.Range("A:H") r.Copy Workbooks.Add.Sheets(1).Range("A1") End Sub
[/vba]
Т.е. нужно было только вот это? [vba]
Код
Sub tt() Dim r As Range '-----Копирование столбцов из старой книги в новую книгу---------- Set r = ActiveSheet.Range("A:H") r.Copy Workbooks.Add.Sheets(1).Range("A1") End Sub