انتقال اطلاعات به شیت های هم نام

[ali.b]

با سلام
با این کد میتونین اطلاعات یک ردیف رو میتونید به شیت های مورد نظرتون انتقال بدین مثلا اگه در یک ردیف اسم سلول H3 به نام اکسل باشه هموه اطلاعات رو به همون شیتی که به نام اکسل هست انتقال میده اما میخوامبدون روش و فرمول دیگه ای غیر از این کد هست ؟

Sub Button1_Click()On Error Resume Next
Dim c As Range
Dim d As Range
For i = 1 To Sheets.Count
    For Each c In Sheet1.Range("h3:h200")
        If c.Value = Sheets(i).Name Then
            Rows(c.Row).Select
            Selection.Copy
            Sheets(i).Activate
            Range("a1").Select
            Selection.End(xlDown).Select
            ActiveCell.Offset(1, 0).Range("a1").Select
            Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
            Sheet1.Rows(c.Row).ClearContents
            Application.CutCopyMode = False
            Sheet1.Select
        End If
    Next c
Next i
Sheet1.Select
Range("a3").Select
End Sub