Hi,
I am actually using 1 macro to open a folder using a command button and run multiple macro on the file. The macro that run on the file does split worksheet, and split each worksheet into separate excel file. But when I try to do it, it doesnt work.
This is the open macro:
and the part that is not working is:
Any help will be thankful!
I am actually using 1 macro to open a folder using a command button and run multiple macro on the file. The macro that run on the file does split worksheet, and split each worksheet into separate excel file. But when I try to do it, it doesnt work.
This is the open macro:
Code:
Sub Split()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & Application.PathSeparator 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
'Replace the line below with the statements you would want your macro to perform
Call SplitFiles
Application.ScreenUpdating = True
End SubCode:
'Sub excelsplit()
Dim wbk1 As Workbook
Dim l_str, l_end, l_row As Long
Set wbk1 = ThisWorkbook
'to remove unwanted worksheets on the workbook
Application.DisplayAlerts = False
Do Until wbk1.Sheets.Count = 1
wbk1.Sheets(wbk1.Sheets.Count).Delete
Loop
Application.DisplayAlerts = True
'to read the data from first sheet
l_str = 2
l_row = 2
Do While l_row <= wbk1.Sheets(1).Range("A65536").End(xlUp).Row + 1
If wbk1.Sheets(1).Range("A" & l_row).Value = "" And _
wbk1.Sheets(1).Range("B" & l_row).Value = "" And _
wbk1.Sheets(1).Range("C" & l_row).Value = "" Then
wbk1.Sheets.Add after:=wbk1.Sheets(wbk1.Sheets.Count)
wbk1.Sheets(wbk1.Sheets.Count).Range("A2:Z" & l_row - l_str + 1).Value = wbk1.Sheets(1).Range("A" & l_str & ":Z" & l_row).Value
l_str = l_row + 1
End If
l_row = l_row + 1
Loop
'End Sub
'Sub DeleteNoData
For Each sht In Sheets
If Not sht.UsedRange.Find("NO DATA", , , 1) Is Nothing Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
End If
Next
'End Sub
'Sub RenameTabs()
Dim l As Long
For l = 1 To Sheets.Count
With Worksheets(l)
If .Range("B8").Value <> "" And _
.Range("B9").Value <> "" And _
.Range("B10").Value <> "" Then
.Name = "DMO_" & Right(.Range("B10").Value, 5)
End If
End With
Next l
'End Sub
'Sub Splitbook()
'Split separate workbook into separate spreadsheet.
MyPath = ThisWorkbook.Path
For Each shtg In ThisWorkbook.Sheets
shtg.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & shtg.Name & ".xls"
ActiveWorkbook.Close savechanges:=False
Next shtg
'End Sub