- 帖子
- 4
- 主題
- 1
- 精華
- 0
- 積分
- 8
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2013-10-22
- 最後登錄
- 2017-10-5
|
我只要把資料搬移到B檔的欄位,而不是要搬移新的檔案,有誰可以教我修改?
Sub TEST()
Dim ar, r As Long, i As Long
Dim cIndexOld, cIndexNew, arNewHeader
Dim f
cIndexOld = Array(4, 5) 'A檔案中要搬動的欄
cIndexNew = Array(4, 5) '搬到B檔位置(欄號)
arNewHeader = Array("新戶籍地址", "新通訊地址") 'B檔標題名稱
f = Application.GetOpenFilename(FileFilter:="Excel 活頁簿 (*.xls),*.xls", Title:="選擇來源檔案")
If Not TypeName(f) = "String" Then Exit Sub '取消則結束
Application.ScreenUpdating = False
With Workbooks.Open(f)
With .Sheets(1)
ar = .Range("A2:E" & .[A2].CurrentRegion.Rows.Count).Value
End With
.Close False
End With
Application.ScreenUpdating = True
r = UBound(ar)
With Workbooks.Add
With .Sheets(1)
For i = LBound(cIndexOld) To UBound(cIndexOld)
.Cells(1, cIndexNew(i)).Resize(r).Value = Application.WorksheetFunction.Index(ar, 0, cIndexOld(i))
.Cells(1, cIndexNew(i)).Value = arNewHeader(i)
Next
End With
End With
End Sub |
|