从另一个调用一个子例程

Question

I'm trying to unmerge and duplicate data for a folder of xlsx files.

Separately, both macros work as intended. When I combine the macros (through "Call"), it executes but then brings me back to the macro screen. It doesn't give me any errors, but I need to close excel to start over.

I'm guessing the "UnMergeFill" macro isn't playing nice with being opened automatically?

I've tried using "call" and also with just the name of the sub. I've also tried separating the subs into different modules.

Sub AllWorkbooks()

   Dim MyFolder As String
   Dim MyFile As String
   Dim wbk As Workbook

On Error Resume Next

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "Please select a folder"

.Show

.AllowMultiSelect = False

   If .SelectedItems.Count = 0 Then

MsgBox "You did not select a folder"

      Exit Sub

   End If

MyFolder = .SelectedItems(1) & "\"

End With

MyFile = Dir(MyFolder)

Do While MyFile <> “”

   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)


UnMergeFill


wbk.Close savechanges:=True

MyFile = Dir

Loop

Application.ScreenUpdating = True

End Sub


Call Sub UnMergeFill()

Dim cell As Range, joinedCells As Range

For Each cell In ThisWorkbook.ActiveSheet.UsedRange
    If cell.MergeCells Then
        Set joinedCells = cell.MergeArea
        cell.MergeCells = False
        joinedCells.Value = cell.Value
    End If
Next

End Sub

'''

Answer 1

Try This:

Sub AllWorkbooks()

   Dim MyFolder As String
   Dim MyFile As String
   Dim wbk As Workbook

On Error Resume Next

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "Please select a folder"

.Show

.AllowMultiSelect = False

   If .SelectedItems.Count = 0 Then

MsgBox "You did not select a folder"

      Exit Sub

   End If

MyFolder = .SelectedItems(1) & "\"

End With

MyFile = Dir(MyFolder)

Do While MyFile <> “”

   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)


Call UnMergeFill(wbk)


wbk.Close savechanges:=True

MyFile = Dir

Loop

Application.ScreenUpdating = True

End Sub


Sub UnMergeFill(wb As Workbook)

Dim cell As Range, joinedCells As Range

For Each cell In wb.ActiveSheet.UsedRange
    If cell.mergeCells Then
        Set joinedCells = cell.MergeArea
        cell.mergeCells = False
        joinedCells.Value = cell.Value
    End If
Next

End Sub