vba для копирования диапазона ячеек в новую книгу

Question

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

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 

Answer 1

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

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