2017-02-23 40 views
0

Я хочу скопировать несколько листов в новую книгу, начиная с диапазона (A3), до конца таблицы каждой таблицы, поэтому был использован следующий код, но он копировал весь лист.vba для копирования диапазона ячеек в новую книгу

Private Sub Copytonewworkbook_Click() 
Dim NewName As String 
Dim nm As name 
Dim ws As Worksheet 

If MsgBox("Copy specific sheets to a new workbook" & vbCr & _ 
"New sheets will be pasted" , vbYesNo, "NewCopy") = vbNo Then 
Exit Sub 
With Application 
.ScreenUpdating = False 
On Error GoTo ErrCatcher 
Sheets(Array("Payroll", " Bank Letter")).Copy 
On Error Resume Next 
For Each ws In ActiveWorkbook.Worksheets 
    ws.Cells(3,33)Paste:=xlCellTypeFormulas 
    Application.CutCopyMode = False 
    Cells(1, 1).Select 
    ws.Activate 
    Next ws 
    Cells(1, 1).Select 
    For Each nm In ActiveWorkbook.Names 
    nm.Delete 
    Next nm 
    NewName = InputBox("Please Specify the name of your new workbook", "New Copy") 
    ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls" 
    ActiveWorkbook.Close SaveChanges:=False 
    .ScreenUpdating = True 
    End With 
    Exit Sub 
    ErrCatcher: 
    MsgBox "Specified sheets do not exist within this workbook" 
    End Sub 

ответ

0

Это возможный способ сделать это (немного продвинутый, так как он не использует копию, но получает значения):

Public Sub CopyMe() 

    Dim lLastRow As Long 
    Dim rngToCopy As Range 
    Dim shtTarget As Worksheet 

    With ActiveSheet 
     lLastRow = .Cells(.Rows.Count, 1).End(xlUp).row 
     Set rngToCopy = .Rows("3:" & lLastRow) 
    End With 

    Set shtTarget = ActiveWorkbook.Worksheets("Report") 

    shtTarget.Rows("1:" & rngToCopy.Rows.Count).value = rngToCopy.value 

End Sub 

скопировать строки из третьего последнее значение в первом столбце активной таблицы на лист с именем Report.

Дополнение: На лету, не пытаясь вы можете сделать это следующим образом:

Sheets(Array("Payroll", " Bank Letter")).Copy 
On Error Resume Next 
For Each ws In ActiveWorkbook.Worksheets 
    ws.Paste:=xlCellTypeFormulas 
    WS.ROWS("1:3").Clear 
+0

Благодаря Vityata, это хороший способ при копировании готового листа в той же книге, но то, что я хочу сделать, это для копирования нескольких листов на основе определенного диапазона в одной книге в новую книгу, как в моем коде, но для исправления требуется исправление, чтобы иметь возможность сделать это специально в этой строке (ws.Cells (3,33) Paste: = xlCellTypeFormulas) –

+0

@NabilAmer - см. издание. В общем, определенно более разумный способ сделать это, но вы должны изменить весь свой код для него. На самом деле это 15-минутная работа. – Vityata

+0

Не могли бы вы, если возможно, внести изменения в мой код? –

Смежные вопросы