要同一文件下的所有工作薄中的 E3,T3,E4,T4,E5,T5 单元格里的内容，提取到 汇总.xlsx 工作薄中，第一个工作薄 提取的内容填到的A2~F2，第二个工作薄 提取的填到A3~F3，请大神帮帮忙
第1个回答 2023-01-11
Sub 循环文件()
Dim FileN$, Arr, i&
FileN = Dir(ThisWorkbook.Path & "\*.xl*")
Do While Len(FileN) <> 0
If FileN <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & FileN
Arr = Array([E3].Value, [T3].Value, [E4].Value, [T4].Value, [E5].Value, [T5].Value)
ActiveWorkbook.Close False
i = i + 1
' Cells(2, i).Resize(6, 1) = Application.WorksheetFunction.Transpose(Arr)
Cells(i, 1).Resize(1, 6) = Arr
End If
FileN = Dir
Loop
End Sub
注意：i=i+1行下方改为了横向要求。追问
Dim FileN$, Arr, i&
FileN = Dir(ThisWorkbook.Path & "\*.xl*")
Do While Len(FileN) <> 0
If FileN <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & FileN
Arr = Array([E3].Value, [T3].Value, [E4].Value, [T4].Value, [E5].Value, [T5].Value)
ActiveWorkbook.Close False
i = i + 1
' Cells(2, i).Resize(6, 1) = Application.WorksheetFunction.Transpose(Arr)
Cells(i, 1).Resize(1, 6) = Arr
End If
FileN = Dir
Loop
End Sub
注意：i=i+1行下方改为了横向要求。追问
是的，都是只有一个工作表
追答Sub 循环文件()
Dim FileN$, Arr, i&
FileN = Dir(ThisWorkbook.Path & "\*.xl*")
Do While Len(FileN) 0
If FileN ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & FileN
Arr = Array([E3].Value, [T3].Value, [E4].Value, [T4].Value, [E5].Value, [T5].Value)
ActiveWorkbook.Close False
i = i + 1
Cells(2, i).Resize(6, 1) = Application.WorksheetFunction.Transpose(Arr)
End If
FileN = Dir
Loop
End Sub
Do那里红色的
箭头处的不等于 被 度娘 吃了，她们太贪吃了。
