Sub merge_zzllrr()
Dim s, sht, shts
s = "一二三四五六七八九十一二"
Set shts = Sheets("合并")
shts.Cells.Clear
Sheets("一").Range("A1:F1").Copy shts.Range("A1:F1")
For i = 1 To 12
Set sht = Sheets(IIf(i > 10, "拾", "") & Mid(s, i, 1))
sht.Range("A2:G" & sht.Columns(1).Find("*", , , , 1, 2).Row).Copy shts.Range("A" & (shts.Columns(1).Find("*", , , , 1, 2).Row + 1))
Next i
End Sub