我们可以不要懂VBA，但要会懂得用VBA！每个人都可以创建一个属于自己的【E帮办公】。

情景

分久必合，合久必分。昨天向下合并空白单元格后，今天又想拆分单元格了。除了拆分单元格，还想把单元格里的内容填充到每个拆分后的单元格中。

方案

我们用一个变量接收合并单元格中的内容，拆分完后，再把变量填充到每个单元格中。

如果你觉得有用，还希望给个【关注】给个【赞】！

如果你想要自己的小功能，点击【关注】，在评价区留下小功能的要求！

有需要，可【关注】后【私信】“拆分单元格并填充内容”获取窗体及模块。

创建自己的选项卡及将程序添加到选项卡中，参照文章【VBA小程序的添加——创建自己的选项卡】

附上代码供参考

模块代码：

Sub 拆分单元格并填充内容()
Application.DisplayAlerts = False ’//关闭系统提示
Application.EnableEvents = False ’//禁止触发其他事件
UserForm4.Show
Application.EnableEvents = True ’// ’//恢复触发其他事件
Application.DisplayAlerts = True ’//恢复系统提示
End Sub

窗体代码：

Private Sub CommandButton1_Click()
Dim rng As Range
startRow = TextBox1.Value
endRow = TextBox2.Value
bCol1 = TextBox3.Value
startCol = Range(bCol1 & "1").Column
bCol2 = TextBox4.Value
endCol = Range(bCol2 & "1").Column
If TypeName(startRow) = "String" Then startRow = Val(startRow)
If TypeName(endRow) = "String" Then endRow = Val(endRow)
If TypeName(startCol) = "String" Then startCol = Val(startCol)
If TypeName(endCol) = "String" Then endCol = Val(endCol)
If startRow = "" Or endRow = "" Or startCol = "" Or endCol = "" Then MsgBox "请完善参数！", vbInformation, "提示": Exit Sub
If endRow < startRow Or endCol < startCol Then MsgBox "结束行（列）必须大于起始行（列）！", vbInformation, "提示": Exit Sub
For Each rng In ActiveSheet.Range(Cells(startRow, startCol), Cells(endRow, endCol))
 rngRow = rng.Row
 rngCol = rng.Column
 m = rng.MergeArea.Rows.Count
 n = rng.MergeArea.Columns.Count
 If m > 1 Or n > 1 Then
 rng.UnMerge
 For i = 1 To n
 For j = 1 To m
 Cells(rngRow + j - 1, rngCol + i - 1) = Cells(rngRow, rngCol)
 Next j
 Next i
 End If
Next
Application.ScreenUpdating = True
Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub TextBox1_AfterUpdate() ’起始行
If TextBox1.Value < 1 Or TextBox1.Value > 9999 Then MsgBox "请输入1~9999之间的数值", , "提示": TextBox1 = 1
End Sub
Private Sub TextBox2_AfterUpdate() ’终止行
If TextBox2.Value < 2 Or TextBox2.Value > 10000 Then MsgBox "请输入2~10000之间的数值", , "提示": TextBox2 = 2
End Sub
Private Sub TextBox3_AfterUpdate() ’起始列
isABC = Asc(Left(TextBox3.Value, 1))
If isABC < 65 Or isABC > 90 And isABC < 97 Or isABC > 122 Then MsgBox "请正确输入列标（ABC...)!", , "提示": TextBox3 = "A"
End Sub
Private Sub TextBox4_AfterUpdate() ’终止列
isABC = Asc(Left(TextBox4.Value, 1))
If isABC < 65 Or isABC > 90 And isABC < 97 Or isABC > 122 Then MsgBox "请正确输入列标（ABC...)!", , "提示": TextBox4 = "B"
End Sub
Private Sub UserForm_Activate()
If TypeName(Selection) = "Range" Then
 TextBox1.Text = Selection(1).Row
 TextBox2.Text = Selection(1).Row + Selection.Rows.Count - 1
 a = Selection(1).Column
 lB1 = Cells(1, a).Address
 TextBox3 = Mid(lB1, 2, InStr(2, lB1, "$") - 2)
 b = Selection(1).Column + Selection.Columns.Count - 1
 lB2 = Cells(1, b).Address
 TextBox4.Text = Mid(lB2, 2, InStr(2, lB2, "$") - 2)
End If
End Sub