想在不同的檔案中，捉取不同sheet中相同位置的資料，有機會實現嗎? - Excel程式區

[發問] 想在不同的檔案中，捉取不同sheet中相同位置的資料，有機會實現嗎?

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2014-1-20 11:23 | 顯示全部帖子

回復 3# chres
若要從第6列開始貼上資料,7到12列是合併的儲存格資料會失真

使用不同檔案名稱,修改如下

Option Explicit
Sub ex()
Dim Ay(), Sh As Worksheet, Ar, I As Integer, J As Integer, S As Integer
Dim WB As Workbook
Set WB = ActiveWorkbook '作用中的活頁簿
'Set WB = Workbooks("A.xls") '指定的活頁簿
Ar = Array("B", "C", "D", "P", "Z", "AJ", "AT", "BL", "BM", "BP", "BQ", "BR", "CM", "CW", "DG", "EB", "EC")
Set Sh = WB.Sheets.Add(after:=Sheets(Sheets.Count))
For I = 5 To 6
With WB.Sheets(I)
For J = 0 To UBound(Ar)
ReDim Preserve Ay(S)
Ay(S) = Application.Transpose(.Range(Ar(J) & 13 & ":" & Ar(J) & 268))
S = S + 1
Next
Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(256, UBound(Ar) + 1) = Application.Transpose(Ay)
S = 0
Erase Ay
End With
Next
Sh.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Set Sh = Nothing
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 慈悲沒有敵人，智慧不起煩惱。