- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 15# linsurvey2005
不了解你的涵義: 13# 資料顯示合併為A1:C50,G1:H50(D1:E50的資料已被G1:H50蓋過),我想讓資料合併為A1:E50,G1:H50
ctrl+相對儲存格數目 => 選取多重的範圍
修改Hsieh超版 11#的程式碼試試看- Option Explicit
- Sub Selection_Copy()
- Dim fs$, SRng As Range, SourceWb As Workbook, r As Integer, k As Range, myfilename As String
- On Error Resume Next
- fs = Application.GetOpenFilename("Excel 檔案(*.xls),*.xls")
- Set SourceWb = Workbooks.Open(fs)
- Set k = Application.InputBox("請選取欲複製的範圍", , , , , , , 8) '物件:Range
- If Err.Number <> 0 Then GoTo 10 '取消InputBox的輸入->k不為物件會有錯誤
- With Workbooks.Add.Sheets(1) '物件:新增活頁簿的第1個工作表
- '新增活頁簿時,作用中的活頁簿會移到此新增活頁簿
- SourceWb.Activate '作用中的活頁簿:此活頁簿
- Do
- For Each SRng In k.Areas 'Areas 集合，此集合代表多重範圍中的所有範圍
- r = Application.Max(12, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
- .Cells(r, 1).Resize(SRng.Rows.Count, SRng.Columns.Count) = SRng.Value
- Next
- If MsgBox("是否繼續", vbYesNo) = vbNo Then Exit Do
- Set k = Application.InputBox("請選取欲複製的範圍", , , , , , , 8)
- If Err.Number <> 0 Then Exit Do '取消InputBox的輸入->k不為物件會有錯誤
- Loop
- .Activate
- DoEvents
- myfilename = Format(Date, "yymmdd") & "-Tilt-PDA.xls"
- Application.SendKeys myfilename, True
- fs = Application.GetSaveAsFilename("E:\")
- If fs <> False Then .Parent.SaveAs fs
- .Parent.Close 0
- End With
- 10:
- SourceWb.Close 0
- End Sub
|
|
發表於 2013-7-2 09:45
| 
