Data transfer

[ahamed982]

Hi Everyone

I have master sheet (for debtors collection) where I have date, customer name,customer code, invoice no, invoice amount in columns. Beside the master sheet for each customer, a sheet (in the same book) is maintained by the name of customer code.

The practice : Every time when a new invoice is raised, first I enter into the master sheet and then the same information is entered again in to the customer sheet.

I need a VB code, that can execute following task ;

When I enter the information in the master sheet and run the macro, the same information should be updated in the customer sheets as well. The master sheet's customer code and the name of customer sheet is same.

Additional Info:

Master sheet / Customer sheets data stars from A3 ....

Thank you in advance.

Hope this is clear..

Have a nice day

 

[sgmpatnaik]

@ahamed

Hello

It is better to upload a sample file

 

[ahamed982]

Hi Their !!

Here is the sample file for further reference.

Thanks

 

[sgmpatnaik]

Thanks for your file,

give me some couple of time to complete your task

 

[Smallman]

Give this a crack. Now lets be clear, you don't have Muppet protection in this code. It assumes for every name in Column C you have a corresponding sheet.

I will attach a workbook to prove workings.

Sub MovetoSheets()
Dim i As Integer
 
    Columns("K").ClearContents
    Range("C2", Range("C65536").End(xlUp)).AdvancedFilter 2, , [k1], 1
 
    For i = 2 To Range("K" & Rows.Count).End(xlUp).Row
        Range("C2", Range("C65536").End(xlUp)).AutoFilter 1, Range("K" & i)
        Sheets(Range("K" & i).Value).Range("a3:F1000").ClearContents
        Range("A2", Range("F65536").End(xlUp)).Copy Sheets(Range("K" & i).Value).[a2]
    Next i
 
[c2].AutoFilter
Columns("K").ClearContents
End Sub

Take care

Smallman

 

[ahamed982]

Hi!!

Thank you very much for the kind effort and the help, I am going to check now..

Thanks once again...

Regards

RIfkan

 

[Smallman]

No Worries Rifkan

Please come back if you have further questions or encounter any issues.

Take it easy

Smallman

 

[dan_l]

god damn muppets screw up my vba all the time.

 

[Smallman]

 

[sgmpatnaik]

@ahmed

Hi

Please check this file too what is the difference in this code that is when ever you add a new name in the Column C then it will add the new sheet with that name and copy the data to there

for your better knowledge i attached the same file

Sub Move_Data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
 
vcol = 3 'CHANGE THE COLUMN NUMBER AS PER YOUR NEED
 
Set ws = Sheets("Master") 'CHANGE THE SHEET NAME AS PER YOUR NEED
 
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
 
title = "A2:F2" 'CHANGE THE TITLE ROW AS PER YOUR NEED
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
 
ws.Cells(1, icol) = "Unique"
 
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
 
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
 
ws.Columns(icol).Clear
 
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
 
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
 
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
 
ws.AutoFilterMode = False
ws.Activate
 
End Sub

ps: Smallman code is simple and beautiful i made this code base with that

Thanks

Patnaik

 

[ahamed982]

Dear sgmpatnail

Thank you for your generous effort,, It is definitely going to be useful to me.



Thanks once again. Regards / ahamed

 

[ahamed982]

Dear sgmpatnail

When I run the macro you have shared with me, I found that data falls out of the range also being copied to the corresponding sheet. The data only within the range from A to F should be copied. How can I alter your macro in this regard.

Thanking you,

 

[sgmpatnaik]

@ahamed

Hi

Sorry for my late replay,

Please change the previous codes one line

the old code is

ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")

Change to

ws.Range("A" & titlerow & ":A" & lr).Range("A1:F2000").Copy Sheets(myarr(i) & "").Range("A1")

Hope this will solve your problem

if any problem please inform

Thanks

Patnaik

 

[ahamed982]

Dear Patnaik

Thank you for the code.