Option Explicit
Sub TEST()
Dim Z, PH$, FN$, i&, C As Range, xB As Workbook, S As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
For Each S In Worksheets
For Each C In S.[1:1].SpecialCells(2): Set Z(S.Name & "|" & C) = ThisWorkbook.Sheets(S.Name).Range(C.Address): Next
Next
PH = ThisWorkbook.Path
Application.ScreenUpdating = False
Do
If FN = "" Then FN = Dir(PH & "\*.xlsx") Else FN = Dir
If FN = "" Then Exit Do
'If FN = ThisWorkbook.Name Then GoTo DP
Set xB = Workbooks.Open(PH & "\" & FN, ReadOnly:=True)
For Each S In Worksheets
For Each C In S.[1:1].SpecialCells(2)
If Z.Exists(S.Name & "|" & C) = Empty Then GoTo C01
C.EntireColumn.Copy Z(S.Name & "|" & C)
C01: Next
Next
xB.Close 0
DP: Loop
End Sub作者: Andy2483 時間: 2024-1-3 15:57
