رفع خطای کد vba

[arsalan135]

سلام و درود خدمت اساتید و دوستان عزیز
در اکسل در شیت ۱، جدولی از داده ها با سر ستون های زیر را داریم :
۱- Date
۲- Name
۳- Bdehi
۴- Bestan

می خواهم با کدنویسی وقتی در سلول A1 از شیت ۲, یک نام را از جدول داده ها در شیت ۱، انتخاب می کنیم، یک جدول جدید در شیت ۲، ایجاد شود بگونه ای که فقط ردیف هایی را در جدول جدید نشان دهد که محتوای سلول مربوط به ستون نام آن مطابق محتوای سلول A1 از شیت ۲، باشد. مثلا در جدول اصلی که در شیت ۱، داریم شامل داده هایی با نام های مختلف وجود دارد ، می خواهیم با انتخاب نام احمد در سلول A1 از شیت ۲، تمام ردیف هایی که نام احمد دارد، جدولی در شیت ۲ ایجاد شود که فقط شامل نام احمد در ستون نام از جدول موجود در شیت ۱ است.
این نکته را در هم در نظر بگیر که از نسخه اکسل 2016 استفاده می شود. یعنی به تابع Filter دسترسی نداریم.
البته یک کد یکی از دوستان برای من نوشت که خطای Run Time Error 1004 رو میده ، کد و فایل اکسل رو میزارم ، لطفا دوستان راهنمایی کنید. چنانچه دوستان راهکاری دیگه ای هم داشته باشند مثل فرمول نویسی در خود اکسل که جایگزین تابع Filter بشه و همین کار رو انجام بده هم ممنون می شوم

Sub FilterDataByName()
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim lastRow As Long
Dim targetRow As Long
Dim nameToFilter As String
Dim i As Long


Set wsSource = ThisWorkbook.Sheets("sheet1")
Set wsTarget = ThisWorkbook.Sheets("sheet2")


wsTarget.Cells.Clear


nameToFilter = wsTarget.Range(A1).Value



lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row


wsTarget.Range("B1:E1").Value = Array("Date", "Name", "Bedehi", "Bestan")

targetRow = 2

For i = 2 To lastRow
If wsSource.Cells(i, 2).Value = nameToFilter Then
wsTarget.Cells(targetRow, 1).Value = wsSource.Cells(i, 1).Value
wsTarget.Cells(targetRow, 2).Value = wsSource.Cells(i, 2).Value
wsTarget.Cells(targetRow, 3).Value = wsSource.Cells(i, 3).Value
wsTarget.Cells(targetRow, 4).Value = wsSource.Cells(i, 4).Value
targetRow = targetRow + 1
End If
Next i

End Sub

[karimi6155]

سلام
علت خطاتون اینه که در Range(A1).Value علامتهای کوتیشن رو نگذاشتید به صورت Range("A1").Value البته تغییرات دیگه ای هم لازم داره تا نتیجه ای که میخواهید رو نمایش بده به این صورت:

Sub FilterDataByName()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim targetRow As Long
    Dim nameToFilter As String
    Dim i As Long
    Set wsSource = ThisWorkbook.Sheets("sheet1")
    Set wsTarget = ThisWorkbook.Sheets("sheet2")
    nameToFilter = wsTarget.Range("A1").Value
    wsTarget.Range("B:E").Clear
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    wsTarget.Range("B1:E1").Value = Array("Date", "Name", "Bedehi", "Bestan")
    targetRow = 2
    For i = 2 To lastRow
        If wsSource.Cells(i, 2).Value = nameToFilter Then
            wsTarget.Cells(targetRow, 2).Value = wsSource.Cells(i, 1).Value
            wsTarget.Cells(targetRow, 3).Value = wsSource.Cells(i, 2).Value
            wsTarget.Cells(targetRow, 4).Value = wsSource.Cells(i, 3).Value
            wsTarget.Cells(targetRow, 5).Value = wsSource.Cells(i, 4).Value
            targetRow = targetRow + 1
        End If
    Next i
End Sub

به روشهای دیگه ای هم میشه این کد رو نوشت که دو نمونه دیگه اش رو در پیوست میتونید ببینید