Copy Data to sub sheets

[BABU Baru]

The following code works good to copy data to other sheets named in Column "A" but it copy the entire rows
I want to copy only from column A2:D2 & rows can be many.
Can any expert hear help me please?

Sub YYY2()
Dim wsRng As Range, i As Long
Application.ScreenUpdating = False

Set wsRng = Sheets("Data").Range("A1:A" & Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row)
For i = 1 To ThisWorkbook.Worksheets.Count

If Worksheets(i).Name <> "Data" Then

With Worksheets(i)

With .Range("A1", .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
If .Rows.Count > 1 Then
.Offset(1).Resize(.Rows.Count - 1).ClearContents
End If
End With

End With

With wsRng
.AutoFilter 1, Worksheets(i).Name
On Error Resume Next
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Copy _
Worksheets(i).Range("A" & Worksheets(i).Rows.Count).End(xlUp).Offset(1)
On Error GoTo 0
End With

End If
Next

wsRng.AutoFilter
Application.ScreenUpdating = True
End Sub

 

[JoeMo]

Try changing this line:
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Copy
to this:
.Offset(1).Resize(.Rows.Count - 1,4).SpecialCells(12).Copy

 

[BABU Baru]

Try changing this line:
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Copy
to this:
.Offset(1).Resize(.Rows.Count - 1,4).SpecialCells(12).Copy

Hello Joe,
No, It didn't work at all. I think, I need to set range in copy Syntax.