نمایش نتایج: از شماره 1 تا 9 , از مجموع 9

موضوع: جداسازی شیت های موردنظر

  1. #1


    آخرین بازدید
    تاریخ عضویت
    January 2014
    نوشته ها
    798
    امتیاز
    1667
    سپاس
    591
    سپاس شده
    1,242 در 436 پست
    تعیین سطح نشده است

    جداسازی شیت های موردنظر

    کد:
    Sub CreateDataSheet()    
        Dim ws As Worksheet
        Dim sDataOutputName As String
    
    
        With Application
            .Cursor = xlWait
            .StatusBar = "Saving DataSheet..."
            .ScreenUpdating = False
             
             '       Copy specific sheets
             '       *SET THE SHEET NAMES TO COPY BELOW*
             '       Array("Sheet Name", "Another sheet name", "And Another"))
             '       Sheet names go inside quotes, seperated by commas
            On Error GoTo ErrCatcher
            Sheets(Array("1", "2", "3")).Copy
            On Error GoTo 0
             
             '       Paste sheets as values
             '       Remove External Links, Hperlinks and hard-code formulas
             '       Make sure A1 is selected on all sheets
            For Each ws In ActiveWorkbook.Worksheets
                ws.Cells.Copy
                ws.[A1].PasteSpecial Paste:=xlValues
                ws.Cells.Hyperlinks.Delete
                Application.CutCopyMode = False
                Cells(1, 1).Select
                ws.Activate
            Next ws
            Cells(1, 1).Select
             
             '       Remove named ranges
            RemNamedRanges
            
            Sheets("1").Select
            
            sDataOutputName = Sheets("1").Range("N1").Value & "\" & Sheets("1").Range("B1").Value
             
             '       Save it with the NewName and in the same directory as original
            ActiveWorkbook.SaveCopyAs sDataOutputName & " MyNewDataWorkbook - Data Sheet.xlsx"
            ActiveWorkbook.Close SaveChanges:=False
            
            .Cursor = xlDefault
            .StatusBar = False
            .ScreenUpdating = True
        End With
        Exit Sub
         
    ErrCatcher:
        MsgBox "Specified sheets do not exist within this workbook"
    End Sub
    
    
    Sub RemNamedRanges()
         
        Dim nm              As Name
         
        On Error Resume Next
        For Each nm In ActiveWorkbook.Names
            nm.Delete
        Next
        On Error GoTo 0
         
    End Sub
    اخطار: این یک موضوع قدیمی است
    به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.



  2.  

  3. #2


    آخرین بازدید
    تاریخ عضویت
    January 2014
    نوشته ها
    798
    امتیاز
    1667
    سپاس
    591
    سپاس شده
    1,242 در 436 پست
    تعیین سطح نشده است

    طبق نکته ای که جناب اقای بحرانی گفتن من ی توضیحی در مورد این کد بدم که با این کد شما در قسمت
    کد:
    Sheets(Array("MyData1", "MyData2", "MyData2", "MyData3", _
            "MyData4", "MyData5")).Copy
    نام شیت های مورد نظرتون رو که میخواین جداگانه ذخیره بشن رو وارد میکنینن. دقت کنید که شیت ها کاملا جدا و در فایل دیگه ای هستن پس مواظب باشین اگه لینک دارن باید همراه با منبع در نظر بگرین

    در قسمت زیر هم تنظیمات مربوط به نحوه ذخیره شدن و نحوه انتخاب نام هر فایل هست که به دلخواه میتونین تغییر بدین
    کد:
    Sheets("Cover Sheet").Select        
            sDataOutputName = Sheets("CalcSheet").Range("N9").Value & "\" & Sheets("CalcSheet").Range("B2").Value
             
             '       Save it with the NewName and in the same directory as original
            ActiveWorkbook.SaveCopyAs sDataOutputName & " MyNewDataWorkbook - Data Sheet.xlsx"
            ActiveWorkbook.Close SaveChanges:=False
    هرجا توضیح خوسات من در خدمتم



  4. #3


    آخرین بازدید
    تاریخ عضویت
    January 2014
    نوشته ها
    798
    امتیاز
    1667
    سپاس
    591
    سپاس شده
    1,242 در 436 پست
    تعیین سطح نشده است

    این هم ی کد خیلی ساده تر که همین کار رو انجام میده و جایی که تغییر رنگ دادم برای گرفتم نام فایل و محل ذخیره هست
    کد:
    Sub TwoSheetsAndYourOut()    Dim NewName As String
        Dim nm As Name
        Dim ws As Worksheet
      
            Sheets(Array("1", "2", "3")).Copy
            For Each ws In ActiveWorkbook.Worksheets
                ws.Cells.Copy
                ws.[A1].PasteSpecial Paste:=xlValues
                ws.Cells.Hyperlinks.Delete
                Application.CutCopyMode = False
                Cells(1, 1).Select
                ws.Activate
            Next ws
            Cells(1, 1).Select
            ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Sheet1.Range("a1") & ".xlsx"
            ActiveWorkbook.Close SaveChanges:=False
    End Sub


  5. سپاس ها (2)


  6. #4


    آخرین بازدید
    تاریخ عضویت
    January 2014
    نوشته ها
    798
    امتیاز
    1667
    سپاس
    591
    سپاس شده
    1,242 در 436 پست
    تعیین سطح نشده است

    این دگه خیلی ساده کردم
    کد:
    Sub sep_sheet()
    Sheets(Array("sheet name")).Copy
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Sheet1.Range("a1") & ".xlsx"
            ActiveWorkbook.Close SaveChanges:=False
    End Sub


  7. سپاس ها (1)


  8. #5


    آخرین بازدید
    تاریخ عضویت
    January 2014
    نوشته ها
    798
    امتیاز
    1667
    سپاس
    591
    سپاس شده
    1,242 در 436 پست
    تعیین سطح نشده است

    ی سوال به جای اینکه نام شیت ها رو اینجا بنویسم؟ راهی داره که جور دیگه انجام داد
    یعنی اسم شیت ممکنه حرف ی تهش داشته باشه و دردسر باشه
    کد:
    Sheets(Array("1", "2", "3")).Copy


  9. #6


    آخرین بازدید
    4 هفته پیش
    تاریخ عضویت
    February 2014
    محل سکونت
    تهران
    نوشته ها
    523
    امتیاز
    1130
    سپاس
    2,816
    سپاس شده
    1,050 در 348 پست
    سطح اکسل
    51.00 %

    علی فاطمی به Yahoo ارسال پیام
    نقل قول نوشته اصلی توسط absorkhi نمایش پست ها
    ی سوال به جای اینکه نام شیت ها رو اینجا بنویسم؟ راهی داره که جور دیگه انجام داد
    یعنی اسم شیت ممکنه حرف ی تهش داشته باشه و دردسر باشه
    کد:
    Sheets(Array("1", "2", "3")).Copy
    با سلام ، اگر از index شیتها استفاده کنین مطمئنا بهتره.
    در دنیا فقط یک نفر وجود دارد که باید از او بهتر باشید و آن کسی نیست جز گذشته خودتان




  10. سپاس ها (1)


  11. #7


    آخرین بازدید
    2016/05/20
    تاریخ عضویت
    December 2015
    نوشته ها
    24
    امتیاز
    15
    سپاس
    39
    سپاس شده
    5 در 3 پست
    تعیین سطح نشده است

    سلام یه سئوال خدمت دوستان من میخوام تعداد متغییر شیت رو ، که با رنگ خاص از هم تفکیک شدن و قابل تشخیص هستند ، به صورت هر رنگ یک فایل اکسل جداگانه ، خروجی بگیرم لطفا راهنمایی کنید

  12. #8


    آخرین بازدید
    2023/08/17
    تاریخ عضویت
    March 2015
    محل سکونت
    آمل
    نوشته ها
    3,343
    امتیاز
    11575
    سپاس
    1,885
    سپاس شده
    8,165 در 3,011 پست
    تعیین سطح نشده است

    با سلام

    با کد ذیل هر شیت فایل موجود بصورت یک فایل اکسل در مسیر فایل جاری ذخیره میگردد

    کد PHP:
    Sub Sheet_SaveAs()

      
    Dim wb As Workbook
      
      
    For Each Sheet In Worksheets
      
      xx 
    Sheet.Name
      
      Sheet
    .Copy
      
      Set wb 
    ActiveWorkbook
      
      With wb
      
        
    .SaveAs ThisWorkbook.Path "\" & xx & ".xlsx"
        
        .Close
            
      End With
      
      Next
      
    End Sub 
    فايل هاي پيوست شده فايل هاي پيوست شده

  13. سپاس ها (2)


  14. #9


    آخرین بازدید
    2016/05/20
    تاریخ عضویت
    December 2015
    نوشته ها
    24
    امتیاز
    15
    سپاس
    39
    سپاس شده
    5 در 3 پست
    تعیین سطح نشده است

    خب حالا اگه بخوایم شیت 1 و 2 با هم تویه فایل
    و شیت 3 و 4 و 5 و 6 با هم تویه فایل دیگه ذخیره بشه
    کد رو به چه صورت باید تغییر بدیم؟
    یه سوال دیگه
    اگه من tab color شیتهای 1 و 2 رو سبز و شیتهای 3 و 4 و 5 و 6 رو مشکی کنم
    آیا کدی هست که بر اساس رنگ ، شیتهای همرنگ رو تو فایل مستقل و مجزا ذخیره کنه
    تاکیدم بر اساس رنگ ، به علت متغییر بودن تعداد و نام شیتهاست


اطلاعات موضوع

کاربرانی که در حال مشاهده این موضوع هستند

در حال حاضر 1 کاربر در حال مشاهده این موضوع است. (0 کاربران و 1 مهمان ها)

موضوعات مشابه

  1. جداسازی شیت های اکسل در پوشه جداگانه
    توسط ali.b در انجمن توابع در ويژوال بيسيك - Functions in VBA
    پاسخ ها: 1
    آخرين نوشته: 2014/08/23, 13:07
  2. آشکار سازی سلول های مخفی شده، پس از ذخیره سازی
    توسط only-only در انجمن سوالات اكسل - Excel Questions
    پاسخ ها: 1
    آخرين نوشته: 2012/04/24, 13:06
  3. پویا سازی شیت ها
    توسط z326m در انجمن سوالات پیرامون ويژوال بيسيك - VBA Questions
    پاسخ ها: 0
    آخرين نوشته: 2011/10/11, 17:58

بازدید کنندگان با جستجو های زیر این صفحه را پیدا کرده اند

انجمن اكسل ايران , اكسل , اكسس , سوال و جواب اكسل , سوال اكسس , انجمن اكسل ايران , توابع اكسل, آموزش اكسل, آموزش اكسس, VBA, ويژوال بيسيك

کلمات کلیدی این موضوع

علاقه مندی ها (Bookmarks)

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •  
  • BB code ها فعال هستند
  • شکلک ها فعال هستند
  • کد [IMG] فعال است
  • کد [VIDEO] فعال است
  • کد HTML غیر فعال است