VBA code to copy a specific worksheet from current workbook to a new one

[Uday2013]

Hi,

Can someone help me with writing a vba code for doing the following:

1. Search a specific worksheet in the current workbook
2. Copy that sheet in a new workbook (by creating a new workbook)
3. Activate the new workbook

To start with I've made the following code for searching the particular worksheet, however I'm unable to make a code for the cancel button. Please help me with all that I've mentioned.

Function SheetExists(strWSName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(strWSName)
    If Not ws Is Nothing Then SheetExists = True
End Function

Sub Report()

    Dim strWSName As String
    
SearchAgain:

    strWSName = InputBox("Enter the Certificate #")
    If strWSName = vbNullString Then
        MsgBox "Type the certificate number"
        Exit Sub
    End If
    
    If SheetExists(strWSName) Then
        Worksheets(strWSName).Activate
    Else
        MsgBox "The sheet name does not exist!"
        GoTo SearchAgain
    End If
End Sub

 

[Andrew Poulsom]

Try:

If strWSName = "" Then

If you copy a worksheet without specifying a destination, it is copied to a new workbook which becomes the ActiveWorkbook.

 

[Uday2013]

Hi Andrew, Thanks for the reply.

However can you or anyone help me write the code for the 3 points i have mentioned. I'm just too bad at this.

Thanks!

 

[Andrew Poulsom]

All you need to add is;

Worksheets(strWSName).Copy

 

[Uday2013]

Thanks, this works!

Now I would like to make changes to the pasted sheet in the new workbook. For example, create another new worksheet in the new workbook and link the cells between sheet1 and sheet2.

 

[Andrew Poulsom]

What did you try? As I said the new workbook becomes the ActiveWorkbook (and the copied sheet becomes the ActiveSheet). You can do what you want with those two objects.

 

[Uday2013]

Hi Andrew,

Thanks for the help. I would like to do something more advanced now for which i don't have any expertise in VBA. Following is what intend to do:

1. My workbook consists of a reference sheet (the 1st sheet) which acts like a contents page and other sheets which have data in detail. These sheets are named as per what is mentioned on the 1st sheet.
2. A search box is provided in which the user puts the name of the sheet as specified in the 1st sheet.
3. Excel locates that sheet and copies data from a specific range and copies it to to a new workbook where the target range has been specified.
4. Excel then looks up the 1st sheet again and based on the serial number of the originally searched sheet, searches for 2 sheets prior and after, copies the ranges from respective sheets and pastes it at specified target ranges in the new sheet that was created.
5. For example: sheet1 has a contents table that has a list of all the sheets in that workbook labeled as A,B,C,D,E,F,G. If the user searches for "D", then excel would copy the ranges from "D" as well as from B,C,E,F.

My code currently copies only the searched sheet. Request you to help me:

Function SheetExists(strWSName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(strWSName)
    If Not ws Is Nothing Then SheetExists = True
End Function
Sub Report()

'SEARCH FOR THE TAB--------------
    Dim strWSName As String
SearchBank:

    strWSName = InputBox("Enter the Certificate #")
    
    If strWSName = "" Then
    MsgBox ("Either no value was entered or CANCEL was clicked. Run the program again")
    Exit Sub
    End If
    

    If SheetExists(strWSName) Then
        Worksheets(strWSName).Activate
        Worksheets(strWSName).Copy

 

[Andrew Poulsom]

Please post all your code.

What ranges do you want to copy and where do you want to paste them?

 

[Uday2013]

Sorry for not putting complete code.

From every sheet the source range is standard (B2:Q61). However the data needs to be pasted at the following target cells. As from my previous example the ranges from the following sheets will be pasted at specified cells in the new workbook:

Sheet name/Source Range/Target Cell (in new workbook)
D/(B2:Q61)/B2
B/(B2:Q61)/B67
C/(B2:Q61)/B132
E/(B2:Q61)/B197
F/(B2:Q61)/B262

Function SheetExists(strWSName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(strWSName)
    If Not ws Is Nothing Then SheetExists = True
End Function
Sub Report()

'SEARCH FOR THE TAB--------------
    Dim strWSName As String
SearchBank:

    strWSName = InputBox("Enter the Certificate #")
    
    If strWSName = "" Then
    MsgBox ("Either no value was entered or CANCEL was clicked. Run the program again")
    Exit Sub
    End If
    

    If SheetExists(strWSName) Then
        Worksheets(strWSName).Activate
        Worksheets(strWSName).Copy
        

    Else
        MsgBox "Sheet name does not exist!"
        GoTo SearchBank
    End If
End Sub

 

[Andrew Poulsom]

Try:

Sub Report()
    Dim strWSName As String
    Dim ShNew As Worksheet
    Dim i As Long
    Dim r As Long
SearchAgain:
    strWSName = InputBox("Enter the Certificate #")
    If strWSName = "" Then
        MsgBox ("Either no value was entered or CANCEL was clicked. Run the program again")
        Exit Sub
    End If
    r = 2
    If SheetExists(strWSName) Then
        Worksheets(strWSName).Activate
        Worksheets(strWSName).Copy
        Set ShNew = ActiveSheet
        With ThisWorkbook
            For i = 2 To .Worksheets(strWSName).Index - 1
                If i >= .Worksheets(strWSName).Index - 2 Then
                    r = r + 65
                    .Worksheets(i).Range("B2:Q61").Copy ShNew.Range("B" & r)
                End If
            Next i
            For i = .Worksheets(strWSName).Index + 1 To .Worksheets.Count
                r = r + 65
                .Worksheets(i).Range("B2:Q61").Copy ShNew.Range("B" & r)
                If i = .Worksheets(strWSName).Index + 2 Then Exit For
            Next i
        End With
    Else
        MsgBox "The sheet name does not exist!"
        GoTo SearchAgain
    End If
End Sub