Need Some help about Copy and Paste the data to Multiple Sheets

[sgmpatnaik]

Hello Ninja's


Good Evening


i need some help from you that is i want to copy data to multiple sheets except one column, here i got the code while on searching. now i think to stop copy the Column C to the Multiple sheets but the data is copy and paste in multiple sheets base with the Column C

[pre]

Sub copyPasteData()
Dim strSourceSheet As String
Dim strDestinationSheet As String
Dim lastRow As Long

strSourceSheet = "Data entry"

Sheets(strSourceSheet).Visible = True
Sheets(strSourceSheet).Select

Range("C2").Select
Do While ActiveCell.Value <> ""
strDestinationSheet = ActiveCell.Value
ActiveCell.Offset(0, -2).Resize(1, ActiveCell.CurrentRegion.Columns.Count).Select
Selection.Copy
Sheets(strDestinationSheet).Visible = True
Sheets(strDestinationSheet).Select
lastRow = LastRowInOneColumn("A")
Cells(lastRow + 1, 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets(strSourceSheet).Select
ActiveCell.Offset(0, 2).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub

[/pre]

really helpful for me


Thanks


SP

 

[NARAYANK991]

Hi Patnaik ,


You have posted some code , but you also say that the code does not do what you want done ; can you explain what you wish to do ?


Suppose we start from cell C2 , and find that it is not blank ; what should happen ?


Narayan

 

[sgmpatnaik]

Thanks Narayank Sir


for your replay


actually my aim is i want to copy the data from master sheet to My Customer Individual Sheet as per the above code is doing, actually it's coping the old one and new one also but i want to update the data from master sheet to Customer sheets. now i am using formulas but it will take too much time for calculate and open the workbook so i think to use the code.


In the above mention code it is coping the data base with the Column C to Individual sheets. When it is coping it's coping including Column C which is not necessary for me


Say when i enter the data in Master sheet and i mention the A in Column C then it means the data is related to Sheet A, When we run the code it's starting the work as copy and paste the given cells in the Sheet A


Hope you under stand now other wise please inform me


Thanks


SP

 

[NARAYANK991]

Hi Patnaik ,


I am still not very clear ; let me phrase my understanding in my own words ; please confirm or clarify.


Suppose we start with cell C2 , and it contains the text SheetA.


Suppose your data extends from column A through column P ; so the code is supposed to copy the range A2:B2 to SheetA in the first blank row ; I assume this will be pasted in column A and B.


Next the code should copy the range D22 to SheetA ; I assume this will be pasted in columns D through P.


Is this correct ?


Narayan

 

[sgmpatnaik]

Sir now i am left from system and this msg send from mobile so please dont mind sir i will give full clarification tom. Morning


Thanks for ur responce


Thanks


Sp

 

[sgmpatnaik]

Hello Narayank Sir


Please download the file, in that file i mention all my requiremnts


https://www.dropbox.com/s/whuof6hl3pm8jle/Sample_SP.xlsm


as a simple word i want to copy some cells to my dealers Individual sheets with out duplicate entry


Hope you understand my problem now, if any clarification required then please inform me sir


Thanks for valuable time


Thanks


SP

 

[sgmpatnaik]

Hello


Good After Noon


please correct the below mention code when i run the code i got a error msg for Subscript out of Range

[pre]

Option Explicit
Sub Transfer_New_Only()
Dim i As Long, a As Long, counter As Long
Dim lastrow As Long, c As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
counter = 0
For i = 2 To Sheets.Count
If Sheets(i).Range("D6") = "" Then
a = 0
Else
a = Sheets(i).Range("D6", Sheets(i).Range("D6").End(xlDown)).Rows.Count
End If
counter = counter + a
Next i
If counter = Sheets("Dispatch Register").Range("D6", Sheets("Dispatch Register").Range("D6").End(xlDown)).Rows.Count Then MsgBox "No new entries!": Exit Sub
With Sheets("Dispatch Register")
lastrow = .Cells(.Rows.Count, 6).End(xlUp).Row
For Each c In Range("F" & 6 + counter & ":F" & lastrow)
c.Offset(, -3).Resize(, 1).Copy Sheets(c.Text).Cells(Rows.Count, "B").End(xlUp).Offset(1)
c.Offset(, 1).Resize(, 3).Copy Sheets(c.Text).Cells(Rows.Count, "D").End(xlUp).Offset(1)
c.Offset(, 5).Resize(, 4).Copy Sheets(c.Text).Cells(Rows.Count, "G").End(xlUp).Offset(1)
c.Offset(, 9).Resize(, 2).Copy Sheets(c.Text).Cells(Rows.Count, "L").End(xlUp).Offset(1)
Next c
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

When i press the debug then the error line is display in

c.Offset(, -3).Resize(, 1).Copy Sheets(c.Text).Cells(Rows.Count, "B").End(xlUp).Offset(1)

[/pre]
Thanking you


With Regards


Patnaik