请教：如何用vba编写语句实现将一个工作表中的内容分拆成到多个工作表中。

Question

桩号
高程
桩号
高程

0+000

-47.8
9.27

-38
9.22

-27.9
9.21
0+020

-46.6
9.36

-36.2
9.35

-27
9.33
0+040

-45.3
9.38

-34.5
9.3

-24.3
9.27
0+060

-44
9.34

-32.6
9.33

-22.9
9.31
0+080

-42.8
9.27

-30.8
9.2

-22.7
9.16
……

每个工作表的内容为x+xxx（包含）到下一个x+xxx（不包含）之间的内容，就是

0+000

-47.8
9.27

-38
9.22

-27.9
9.21
格式是这样的，上面的都变形了！多谢各位大侠帮忙了！

Answer 1

这个好办，下面这样的代码就可以：

Option Explicit

Sub xxx()
    Dim i, j, st As Worksheet
    '寻找第一行
    i = 1
    While InStr(Cells(i, 1), "+") = 0
        i = i + 1
    Wend
    '开始输出
    While Cells(i, 1) <> ""
        If InStr(Cells(i, 1), "+") > 0 Then
            Set st = Sheets.Add
            st.Name = Cells(i, 1)
            j = 1
        End If
        Rows(i).Copy st.Rows(j)
        j = j + 1
        i = i + 1
    Wend
End Sub

如果完全没有VBA基础，请使用附件。

追问

首先谢谢大侠的热心帮助！
这个表格已经很好的完成了上面的任务。可是我要是想将上面的数据要求修改下：
1、只选取x+xxx之间的文字（这次不包括x+xxx）。
2、将其拷贝到已有的工作表中（工作表的名称依次为“断面2”、“断面3”……（注意是从断面2开始哦！）），而不用新建工作表。
3、限定拷贝区域：已有工作表中只有A3：E列区域可用，第六列往后开始有其他数据占用！
麻烦“阳光上的桥”大侠了！小弟感激不尽！

追答

你觉得你说清楚了吗，呵呵，x+xxx怎么对应到断面2、3、4……

试试看下面的脚本，假设第一个x+xxx到断面2，无论x为什么内容

Option Explicit
 
Sub xxx()
    Dim i, j, k, st As Worksheet
    '寻找第一行
    i = 1
    While InStr(Cells(i, 1), "+") = 0
        i = i + 1
    Wend
    k = 2 '断面2
    '开始输出
    While Cells(i, 1) <> ""
        If InStr(Cells(i, 1), "+") > 0 Then
            Set st = Sheets("断面" & k)
            k = k + 1
            j = 1
        Else
            range(cells(i,1), cells(i,5)).Copy st.cells(j,1)
            j = j + 1        
        End If
        i = i + 1
    Wend
End Sub