vba to copy range of cells to new workbook

Question

I want to copy multiple sheets to new workbook starting from range (A3) to end of the table of each table, so the following code was used but it copy the entire sheet.

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

Vityata Vityata · Accepted Answer · 2017-02-23T11:11:08

This is a possible way to do it (a little advanced, as it does not use the copy, but it gets the values):

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

You copy the rows from the third to the last value in the first column of the activesheet to a sheet named Report.

Addition: On the fly, without trying you can do it like this:

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

vba to copy range of cells to new workbook

1 Answers