ماکرویی جهت کپی گرفتن اطلاعات یک سلول در شیت های مختلف

[ali65e]

سلام مجدد خدمت دوستان و اساتید محترم
فایل اکسلی دارم که دارای شیت های متغیر است (تعداد و نام شیت ها متغیر است).دوستان عزیز جسارتا ماکرویی می خواستم که بشود با آن ماکرو، اطلاعات سلول a1 را از همه ی شیت های موجود کپی کند و در ستون b پیست کند.

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[Amir Ghasemiyan]

سلام مجدد خدمت دوستان و اساتید محترم
فایل اکسلی دارم که دارای شیت های متغیر است (تعداد و نام شیت ها متغیر است).دوستان عزیز جسارتا ماکرویی می خواستم که بشود با آن ماکرو، اطلاعات سلول a1 را از همه ی شیت های موجود کپی کند و در ستون b پیست کند.

سلام دوست عزيز
اگر در كدهايي كه دادم خدمتتون دقت كنيد ميبينين جواب اين سوالتون رو هم قبلا دادم

[ali65e]

Sub sheetnaming()
Sheets("Sheet2").Select
c = Range("I11").Value
For e = 2 To c + 1
    Name = Range("G" & e).Value
    Sheets("Sheet20").Select
    Sheets("Sheet20").Copy After:=Sheets(Worksheets.Count)
    ActiveSheet.Name = Name
    ActiveSheet.Range("a1") = Name
    Sheets("Sheet2").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Range("G" & e), Address:="", SubAddress:=Name & "!A1", TextToDisplay:=Name


    Range("G2:G40").Select
    With Selection.Font
        .Name = "B Nazanin"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .Color = -10477568
        .TintAndShade = 0
    End With
    With Selection.Font
        .Color = -10477568
        .TintAndShade = 0
    End With
Next e
End Sub

[ali65e]

حالا امیر جان میخوام از یکی از سلول ها (مثلا سلول a1) شیت هایی که این ماکرو ایجاد می کند کپی گرفته شه و سپس اطلاعات کپی گرفته شده در ستون b پیست بشند.
لطفا vba ای که زحمت می کشید می نویسید در یک vba جدا ا از این ماکرویی که خدمتتون گذاشتم باشه.(چون زمان اجرای این ماکرو فرق دارد و باید جداگانه اجرا شود.)

[Amir Ghasemiyan]

حالا امیر جان میخوام از یکی از سلول ها (مثلا سلول a1) شیت هایی که این ماکرو ایجاد می کند کپی گرفته شه و سپس اطلاعات کپی گرفته شده در ستون b پیست بشند.
لطفا vba ای که زحمت می کشید می نویسید در یک vba جدا ا از این ماکرویی که خدمتتون گذاشتم باشه.(چون زمان اجرای این ماکرو فرق دارد و باید جداگانه اجرا شود.)

خدمت شما دوست عزيز

Sub naming()
Sheets("Sheet1").Select
Dim names(100)  As String
For e = 0 To Worksheets.Count - 2
    ActiveSheet.Next.Select
    names(e) = ActiveSheet.name
Next e
Sheets("Sheet1").Select
For e = 0 To Worksheets.Count - 2
    Range("B" & e + 1).Value = names(e)
Next e
End Sub