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.
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?
The 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