Копирование диапазона и вставка в новую книгу
Это должно быть очень просто, но я тралил форумы и поэтому ответы в течение нескольких часов, чтобы найти ответ без везения, поэтому я (неохотно) создаю свой собственный вопрос.
что я пытаюсь сделать, это просто создать новую книгу и скопировать диапазон из другой книги в этой книги. Звучит просто..?
моя оригинальная книга, давайте вызовем Book1. Я пытаюсь создать новую книгу, Book2, которую я скопирую значения ячеек A1:B10 к.
вот одна из версий моего кода (начиная с book1 open):
Range("A1:B10").Copy
Set NewBook = Workbooks.Add
With NewBook
.SaveAs Filename:="Book2.xls"
End With
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Это дает ошибку" PasteSpecial класса диапазона не удалось". Я пробовал следующие исправления без везения:
- добавлено ' Workbooks ("Book2.в XLS").Активации для код
- удалены дополнительные аргументы в специальной строке
- попробовал '.Вставить "вместо".PasteSpecial'
- изменить выбор.PasteSpecial ' to 'Параметру activesheet.PasteSpecial'
- явная ссылка на диапазон копирования, включая справочник по книге и листу
- сначала создайте новую книгу, затем выполните копирование, перед повторной активацией новой книги и вставкой
ни одно из вышеперечисленных решений не работает... любая мудрость на этом этапе будет принята с благодарностью!
2 ответов
это то, что вы пытаетесь? Я прокомментировал код, чтобы у вас не было проблем с пониманием того, что делает код.
Option Explicit
Sub Sample()
Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet, wsO As Worksheet
'~~> Source/Input Workbook
Set wbI = ThisWorkbook
'~~> Set the relevant sheet from where you want to copy
Set wsI = wbI.Sheets("Sheet1")
'~~> Destination/Output Workbook
Set wbO = Workbooks.Add
With wbO
'~~> Set the relevant sheet to where you want to paste
Set wsO = wbO.Sheets("Sheet1")
'~~>. Save the file
.SaveAs Filename:="C:\Book2.xls", FileFormat:=56
'~~> Copy the range
wsI.Range("A1:B10").Copy
'~~> Paste it in say Cell A1. Change as applicable
wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
End Sub
это работает для меня.
Private Sub CommandButton1_Click()
Dim newWB As Workbook, currentWB As Workbook
Dim newS As Worksheet, currentS As Worksheet
'Copy the data you need
Set currentWB = ThisWorkbook
Set currentS = currentWB .Sheets("Sheet1")
currentS .Range("A:M").Select
Selection.Copy
'Create a new file that will receive the data
Set newWB = Workbooks.Add
With newWB
Set newS = newWB.Sheets("Sheet1")
newS.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Save in CSV
Application.DisplayAlerts = False
.SaveAs Filename:="C:\Temporary.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
End With
End Sub