How to Easily Move Worksheets from One Workbook to Another with Excel VBA

If you want to move sheets from one workbook to other workbooks, follow this article and create your own tool to automate the task. Quickly select necessary sheets and copy it swiftly to all other target workbooks

Let’s Prepare the GUI

This tool needs a single sheet in the macro-enabled workbook. Rename the Sheet 1 in the workbook as “ControlPanel”. As shown in the image, create necessary fields to allow the user to pick the source workbook, display sheets from the selected workbook and an option to allow the user to choose sheets that have to be moved to other workbooks. Using shapes, create the necessary button to convert the sheet as GUI of the tool.Create Sheet ControlPanel

Let’s make it functional

Copy the script to a new module into your macro enabled workbook. Attach the macro “p_fpick” to the “Browse” button near the field “Select the workbook”. Attach the macro “Add_Sheet” to the arrow near the field “Select Sheet(s)”. Add the macro “Move_Sheets” to the button “Move” near the field “Selected Sheets”.

Sub P_fpick()
    Dim v_fd As Office.FileDialog
    Set v_fd = Application.FileDialog(msoFileDialogFilePicker)
    With v_fd
        .AllowMultiSelect = False
        .Title = "Please select the Excel workbook"
        .Filters.Clear
        .Filters.Add "Excel", "*.xls*"
        If .Show = True Then
            cp.Range("D4").Value = .SelectedItems(1)
        End If
    End With
    Dim wb As Workbook
    Dim ab As Workbook
    Set ab = ThisWorkbook
    Set wb = Workbooks.Open(cp.Range("D4").Value)
    Dim v_sheets As String
    v_sheets = ""
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If v_sheets = "" Then
            v_sheets = ws.Name
        Else
            v_sheets = v_sheets & "," & ws.Name
        End If
    Next
    wb.Close False
    ab.Activate
    With ab.Sheets(1).Range("D8:F9").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=v_sheets
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Sub Add_sheet()
    If Range("I8").Value = "" Then
        Range("I8").Value = Range("D8").Value
    Else
        Range("I8").Value = Range("I8").Value & "," & Range("D8").Value
    End If
End Sub

Sub Move_Sheets()
    Dim v_sheets() As String
    Dim ab As Workbook
    Dim wb As Workbook
    Set ab = ThisWorkbook
    Dim sb As Workbook
    Set sb = Workbooks.Open(ab.Sheets(1).Range("D4").Text)
    Set wb = Workbooks.Open(ab.Sheets(1).Range("D12").Text)
    v_sheets = Split(ab.Sheets(1).Range("I8").Text, ",")
    Dim intcount As Long
    For intcount = LBound(v_sheets) To UBound(v_sheets)
        sb.Sheets(v_sheets(intcount)).Move After:=wb.Sheets(wb.Sheets.Count)
    Next intcount
    sb.Close False
    wb.Close True
End Sub

How does it work?

VBA CodeThe macro “p_fpick” allows the user to select a workbook. Soon as the user selects a file, the macro reads and displays all sheet names as a drop down. The user can select a sheet name from the drop down and add it to the list of sheets that has to be moved to other workbooks. Using browse button, the user can select multiple destination workbooks. When the button “Move” is pressed, the macro “Move_Sheets”  is executed. Using Split function, each selected sheet name is read from the string variable and these sheets are moved from the source workbook to all selected destination workbooks.  Sheets are moved after the last available sheet in each destination workbook. Please note, you cannot move or copy corrupted xlsx sheets to another workbook.

Author Introduction:

Nick Vipond is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including repair word and outlook recovery software products. For more information visit www.datanumen.com.

Leave a Reply

Your email address will not be published. Required fields are marked *