返回列表 上一主題 發帖

[發問]儲存格設定範圍分割成不同工作表

white945

帖子
23 
主題
0 
精華
0 
積分
31 
點名
0  
作業系統
Win7 
軟體版本
20xx 
閱讀權限
10 
性別
男 
註冊時間
2012-8-11 
最後登錄
2012-8-28 
1# 跳轉到 »
發表於 2012-8-28 14:49 | 顯示全部帖子
回復 1# kilon
  1. Sub SplitSheet()
  2. Dim A As Range, B As Range, r%, Sh As Worksheet
  3. Set A = [A1] 'A1為起點
  4. Do Until A.Address = first '直到再度找到的位置是A1
  5. first = "$A$1"
  6. Set B = Columns("G").Find("報 表 結 束", after:=A.Offset(, 6)) 'G欄中找到報表結束
  7. r = B.Row - A.Row
  8. ad = A.Resize(r + 1, 13).Address
  9. Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
  10. Sh.Name = Replace(A.Offset(3, 3).Text, "/", "")
  11. A.Resize(r + 1, 13).Copy Sh.[A1]
  12. Set A = Columns("A").Find(A, after:=A) '找下一個起點
  13. Loop
  14. End Sub
複製代碼

TOP

white945

帖子
23 
主題
0 
精華
0 
積分
31 
點名
0  
作業系統
Win7 
軟體版本
20xx 
閱讀權限
10 
性別
男 
註冊時間
2012-8-11 
最後登錄
2012-8-28 
2#
發表於 2012-8-29 23:54 | 顯示全部帖子
回復 3# GBKEE

多謝版主提醒
  1. Sub SplitSheet()
  2. Dim A As Range, B As Range, r%, Sh As Worksheet
  3. With Sheet1
  4. Set A = .[A1] 'A1為起點
  5. Do Until A.Address = first '直到再度找到的位置是A1
  6. first = "$A$1"
  7. Set B = .Columns("G").Find("報 表 結 束", after:=A.Offset(, 6)) 'G欄中找到報表結束
  8. r = B.Row - A.Row
  9. Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
  10. Sh.Name = Replace(A.Offset(3, 3).Text, "/", "")
  11. A.Resize(r + 1, 13).Copy Sh.[A1]
  12. Set A = .Columns("A").Find(A, after:=A) '找下一個起點
  13. Loop
  14. End With
  15. End Sub
複製代碼

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
返回列表 上一主題