djedidiahw007
New Member
- Joined
- Sep 19, 2022
- Messages
- 6
- Office Version
- 365
- Platform
- Windows
Hi there,
I've new to VBA and I've put together a script that allows users select the sheets that they want to copy over from various files in a folder:
1) Select the folders that contains the files that contains the sheets that they are looking to move
2) There will be a pop-up user form that allows the user to pick 1 sheet and move that sheet over
The issue I'm currently facing is that I'm trying to build a userform that allows users to select multiple sheets and move those selected sheets to the designated file
But what I'm trying to do is to incorporate this userform + a button that says "Move selected sheets" and corporate that in the code above
I would appreciate it if someone could help me out here. Thanks
I've new to VBA and I've put together a script that allows users select the sheets that they want to copy over from various files in a folder:
1) Select the folders that contains the files that contains the sheets that they are looking to move
2) There will be a pop-up user form that allows the user to pick 1 sheet and move that sheet over
The issue I'm currently facing is that I'm trying to build a userform that allows users to select multiple sheets and move those selected sheets to the designated file
VBA Code:
Sub CopyRelevantTabs()
'PURPOSE: To loop through all Excel files in a specified folder and copy specific tabs to a specific location
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim mySelection As String
Dim FldrPicker As FileDialog
' Application.ScreenUpdating = True
' Application.EnableEvents = True
' Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
Debug.Print myPath
Debug.Print myFile
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(filename:=myPath & myFile)
'Ensure Workbook has opened before moving on
DoEvents
'Identify the correct worksheet
mySelection = InputBox("What tab are you looking for?")
'Need to create a dynamic selection for pasting location
Worksheets(mySelection).Copy After:=Workbooks("Paste To Testing.xlsx").Sheets(Workbooks("Paste To Testing.xlsx").Sheets.Count)
myFile = Left(myFile, Len(myFile) - 5)
On Error GoTo ContinueSaving
ActiveSheet.Name = myFile
Debug.Print mySelection
'Save and Close Workbook
ContinueSaving:
Resume Continuesaving2
Continuesaving2:
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
But what I'm trying to do is to incorporate this userform + a button that says "Move selected sheets" and corporate that in the code above
VBA Code:
Private Sub UserForm_Initialize()
Dim N As Long
For N = 1 To ActiveWorkbook.Sheets.Count
ListBox1.AddItem ActiveWorkbook.Sheets(N).Name
Next N
End Sub
I would appreciate it if someone could help me out here. Thanks