[حل شده] انتقال شیت های یک فایل کسل به اکسل دیگر

[rayeagni]

سلام دوستان وقت بخیر
یک فایل اکسل بنام office 40 با تعدادی شیت دارم میخوام همه اطلاعات و شیت های این فایل رو با استفاده از vba به یک فایل اکسل دیگر بنام my data انتقال بدم. البته ممکنه تعداد شیتها در آینده کم یا زیاد بشه و اسماشون هم فرق کنه.
شدیدا به کمکتون نیاز دارم
لطفا راهنمایی بفرمایید...
با تشکر

[iranweld]

با سلام

اگر هدف شما فقط انتقال شیت های فایل دوم به فایل اول میباشد فیلم پیوست را ملاحظه کنید.

[rayeagni]

با سلام

اگر هدف شما فقط انتقال شیت های فایل دوم به فایل اول میباشد فیلم پیوست را ملاحظه کنید.

دست شما درد نکنه.
شیت ها در هر دو فایل ثابت هستند. من فقط می خوام اطلاعات شیت ها رو با کد vba منتقل کنم. یک باتن بذارم که کد vba رو فعال کنه، فایل مورد نظر رو انتخاب و اطلاعاتش منتقل بشه.
کدی که خودم دارم فقط اطلاعات یک شیت رو منتقل می کنه، می خوام همه اطلاعات شیتها منتقل بشه.

[LEFT]


Sheet1.Select
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel ", "*.xlsx; *.xlsm; *.xlsa; *.xls"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Application.Range("A:J")
wkbCrntWorkBook.Activate
Set rngDestination = Application.Range("A1")
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
End If
End With


[/LEFT]

[rayeagni]

دوستان یک کدی نوشتم کارم رو تا حدودی راه میندازه ولی در صورتی کار می کنه که نام شیت ها تغییر نکنه و تعدادشون ثابت بمونه. می خوام تمام شیت ها با هر نام و تعدادی حتی نام فایل هم تغییر کرد کد خطا نده.

[LEFT][SIZE=4]
[/SIZE]
Sheets("Data").Select
    ActiveWindow.ScrollWorkbookTabs Sheets:=6
    Sheets(Array("Data", "Chart", "Evaluation", "Characteristics", _
        "Characteristics chart", "Characteristics evaluation", "Meter history", _
        "Tariff history")).Select
    Sheets("Tariff history").Activate
    ActiveWindow.SelectedSheets.Delete




Sheet1.Select
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel ", "*.xlsx; *.xlsm; *.xlsa; *.xls"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)


'--------------


Windows("office 40.xlsx").Activate
    Windows("New Microsoft Excel Worksheet.xlsm").Activate
    Windows("office 40.xlsx").Activate
    Sheets(Array("Data", "Chart", "Evaluation", "Characteristics", _
        "Characteristics chart", "Characteristics evaluation", "Meter history", _
        "Tariff history")).Select
    Sheets("Data").Activate
    Sheets(Array("Data", "Chart", "Evaluation", "Characteristics", _
        "Characteristics chart", "Characteristics evaluation", "Meter history", _
        "Tariff history")).Copy Before:=Workbooks( _
        "New Microsoft Excel Worksheet.xlsm").Sheets(1)
    Windows("office 40.xlsx").Activate
    Sheets("Data").Select
    Windows("New Microsoft Excel Worksheet.xlsm").Activate
 
'-------------------


End If
End With


Workbooks("office 40.xlsx").Close SaveChanges:=False
 Sheets("Sheet1").Select
    Sheets("Sheet1").Move Before:=Sheets(1)
Sheet1.Select[/LEFT]