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

[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