A Macro to Fill data from Master table to individual sheet

[Dilusha]

Cus_Code(Column A)	Name (Column B)	TIN (Column C)	VAT (Column D)	Rs.(Column E)
BBE	ABC Perra	104074472	SVAT001084	2550	Row1
BTE	D. KAMAL	114169161	SVAT000585	3256	Row2
DSL	L.SUNIL	114337617	103256	2456	Row3
ELS	F.SILVA	114089087	SVAT000550	11000	Row4
EVE	L.SILVA	104072488	SVAT001890	25000	Row5

<tbody>
</tbody>

I have this table in sheet1 & i have created sheets for each customer by name of its CUS_CODE in same work book.
Now I want a macro to copy this data and paste in relevant sheet & relevant cell as follows.

Name should be pasted in I19 in every sheet.
TIN should be pasted in I17 every sheet
VAT should be pasted in I16 every sheet
RS should be pasted in j29 every sheet

EG. 3256 shuould be printed on J29 in BTE sheet.

There is no duplicate Cus_Code & I Use excel 2007.

please help me .

 

[JackDanIce]

Try:

Sub M1()

    Dim arr()       As Variant
    Dim x           As Long
    Dim headerRow   As Long
        
    headerRow = 1
    arr = sheets("Sheet1").Cells(headerRow + 1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - headerRow + 1, 5).Value
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        With sheets(arr(x, 1))
            'VAT
            .Cells(16, 9).Value = arr(x, 4)
            'TIN
            .Cells(17, 9).Value = arr(x, 3)
            'Name
            .Cells(19, 9).Value = arr(x, 2)
            'RS
            .Cells(29, 10).Value = arr(x, 5)
        End With
    Next x
    
    Erase arr
    
End Sub

 

[Dilusha]

thanks .but error
Run time error9
subscript out of range

 

[JackDanIce]

On what line is that error?

 

[Dilusha]

On what line is that error?

until With Sheets(arr(x, 1)) is ok

 

[Dilusha]

when press f8 after " With Sheets(arr(x, 1))" the error appears .

 

[JackDanIce]

It may be your cell value is not matching the sheet name exactly, try:

Sub M1()


    Dim arr()       As Variant
    Dim x           As Long
    Dim headerRow   As Long
    Dim wks         As Worksheet
    headerRow = 1
    arr = sheets("Sheet1").Cells(headerRow + 1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - headerRow + 1, 5).Value
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        On Error Resume Next
        Set wks = sheets(arr(x, 1))
        On Error GoTo 0
        If Not wks Is Nothing Then
            With wks
            
                'VAT
                .Cells(16, 9).Value = arr(x, 4)
                'TIN
                .Cells(17, 9).Value = arr(x, 3)
                'Name
                .Cells(19, 9).Value = arr(x, 2)
                'RS
                .Cells(29, 10).Value = arr(x, 5)
            End With
            Set wks = Nothing
        End If
    Next x
    
    Erase arr
    
End Sub

 

[Dilusha]

It may be your cell value is not matching the sheet name exactly, try:

Sub M1()


    Dim arr()       As Variant
    Dim x           As Long
    Dim headerRow   As Long
    Dim wks         As Worksheet
    headerRow = 1
    arr = sheets("Sheet1").Cells(headerRow + 1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - headerRow + 1, 5).Value
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        On Error Resume Next
        Set wks = sheets(arr(x, 1))
        On Error GoTo 0
        If Not wks Is Nothing Then
            With wks
            
                'VAT
                .Cells(16, 9).Value = arr(x, 4)
                'TIN
                .Cells(17, 9).Value = arr(x, 3)
                'Name
                .Cells(19, 9).Value = arr(x, 2)
                'RS
                .Cells(29, 10).Value = arr(x, 5)
            End With
            Set wks = Nothing
        End If
    Next x
    
    Erase arr
    
End Sub

now it works .
thanks a lot

 

[JackDanIce]

You're welcome