پرسش خواندن اطلاعات از فایل‌های مختلف

[BehnamValizadeh]

سلام
من یک سری فایل اکسل دارم که مثلا از t001 تا t200 نام گذاری کردم ودر یک فولدر ریختم ( که اطلاعات یک سری اشخاص است) حالا در یک فایل که بیرون آن فولدر است می خواهم بعضی از اطلاعات اون فایل ها را بنویسم بیارم

مثلا در همه فایل های فوق سلول A1 نام شخص است؛ حالا می خواهم بدون اون که اون فایلها را باز کنم در فایل جدید اسامی افراد را پشت سر هم بنویسم
مثلا در ستون d1 محتوای سلول a1 از فایل t001
در ستون d2 محتوای سلول a1 از فایل t002
در ستون d3 محتوای سلول a1 از فایل t003
و....
در ستون a1 اسم فایل های را نوشتم

ضمن این که با عوض کردن فولدر اصلی اطلاعات باز هم خوانده بشه؛ از تابع indirect نتونستم استفاد ه کنم

[smartman]

با پاور کوئری اکسل باید انجام بدید. میتونید فایل هاتون رو بفرستید انجام بدم.

[BehnamValizadeh]

ممنون
نمونه فایل را پیوست کردم فایل هایی که t001 تا t005 گذاشتم دود 280 تا است که می خوام خلاصه اش را توی فایل اصلی بیارم

بدون باز کردن فایل می خواهم بخونه - وقتی فایل ها را باز می کنم مشکلی نداره ولی نمیشه هر دفعه همهی فایل ها را باز کرد[ATTACH]20359[/ATTACH]

[iranweld]

با سلام

فایل پیوست را بررسی کنید

از پنجره باز شده وارد مسیر فولدر مورد نظر شده و فولدر مورد نظر را انتخاب کنید

[BehnamValizadeh]

با سلام - درسته اینو با پاور کویری انجام دادین؟

[iranweld]

با vba انجام شده است

Option Explicit
Private Sub CommandButton1_Click()
Dim directory, xx, yy As String, fileName As String, sheet As Worksheet, i, z1, z2, Z3 As Integer, j As Integer
Dim fDialog
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yy = ActiveWorkbook.Name
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker) 'Optional: FileDialog propertiesfDialog.Title = "Select Data folder"fDialog.InitialFileName = "C:\" If fDialog.Show = -1 Then
  xx = fDialog.SelectedItems(1)
directory = "" & xx & "\" & ""
fileName = Dir(directory & "*.xl??")
End If
Range("a4:l3000").ClearContents
Do While fileName <> ""          Workbooks.Open (directory & fileName)       Sheets("SH").Select          xx = ActiveSheet.Name       ActiveSheet.Range("b3:m9").Copy           Windows(yy).Activate        z2 = ActiveSheet.Cells(Rows.Count, "a").End(xlUp).Row + 2        If z2 <= 2 Then z2 = 5        Range("A" & z2).Select        'ActiveSheet.Paste    Selection.PasteSpecial Paste:=xlPasteValues                Workbooks(fileName).Close        fileName = Dir()    Loop
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub