Modifications and Improvisations in an existing code

[Haree]

Hey !!!, I have a code which is running perfectly fine. The code basically is a stock sheet , I have a separate data sheet in the worksheet along with other sheets . Each sheet is named after a stock Item. What i do is i enter my purchase and sales in my data sheet and when i run my macro it posts the same in their respective sheets. Now i would like the data sheet to be in a separate worksheet .

Sub Copy_Rows()
Application.ScreenUpdating = False
    Dim Cell As Range, R As Range
    Set R = Range("H2:H500")
    For Each Cell In R
    If Cell.Value = "Error" Then
    MsgBox "Kindly Check Errors and try again"
    Exit Sub
    End If
    Next Cell
Range("B2:B500").Select
    Selection.Replace What:=".", Replacement:="-", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Dim Drange As Range
Dim psheet As Worksheet
Set Drange = Range("A2:E500")
For Each psheet In Worksheets
psheet.unprotect Password:="STOCK"
Next psheet
Sheets("Data Sheet").Activate
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("Data Sheet").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
For i = 2 To Lastrow
Lastrowa = Sheets(Cells(i, 1).Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(i, 2).Resize(, 5).Copy Sheets(Cells(i, 1).Value).Rows(Lastrowa)
Next
Drange.ClearContents
For Each psheet In Worksheets
If psheet.Name = "Data Sheet" Then
psheet.unprotect Password:="STOCK"
Else
psheet.Protect Password:="STOCK", AllowFormattingCells:=True, DrawingObjects:=False, Scenarios:= _
        True
End If
Next psheet
MsgBox "Data Updated Successfully"
Application.ScreenUpdating = True
End Sub

Thanks in Advance.

 

[DanteAmor]

Put the macro in the workbook with the "Data Sheet" sheet.
In the macro "stock.xlsx" changes to the name of the workbook that contains the sheets with the stock.

Sub Copy_Rows()
  Dim wb As Workbook, sh As Worksheet, pSheet As Worksheet
  Dim f As Range, c As Range
  Application.ScreenUpdating = False
  
  Set sh = Sheets("Data Sheet")
  Set wb = Workbooks("Stock.xlsx")   'Book name with stock sheets
  Set f = sh.Range("H2:H500").Find("Error", , xlValues, xlWhole, , , False)
  If Not f Is Nothing Then
    MsgBox "Kindly Check Errors and try again"
    Exit Sub
  End If
  
  sh.Range("B2:B500").Replace ".", "-", xlPart, xlByRows, False, False, False
  For Each pSheet In wb.Sheets
    pSheet.Unprotect Password:="STOCK"
  Next pSheet
  For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(3))
    wb.Sheets(c.Value).Range("A" & Rows.Count).End(3)(2).Resize(, 5).Value = c.Offset(, 1).Resize(1, 5).Value
  Next
  
  sh.Range("A2:E500").ClearContents
  For Each pSheet In wb.Sheets
    pSheet.Protect Password:="STOCK", AllowFormattingCells:=True, DrawingObjects:=False, Scenarios:=True
  Next pSheet
  Application.ScreenUpdating = True
  
  MsgBox "Data Updated Successfully"
End Sub

 

[Haree]

Hi @DanteAmor
Thank You So much for your help and time. I have just did a minor change to it.

Sub Copy_Rows()
  Dim wb As Workbook, sh As Worksheet, pSheet As Worksheet
  Dim f As Range, c As Range
  Application.ScreenUpdating = False
 
  Set sh = Sheets("Data Sheet")
  Set wb = Workbooks.Open(Filename:="G:\trial runs\Stock Silver Trial.xlsm")   'Book name with stock sheets
  Set f = sh.Range("H2:H500").Find("Error", , xlValues, xlWhole, , , False)
  If Not f Is Nothing Then
    MsgBox "Kindly Check Errors and try again"
    Exit Sub
  End If
 
  sh.Range("B2:B500").Replace ".", "-", xlPart, xlByRows, False, False, False
  For Each pSheet In wb.Sheets
    pSheet.Unprotect Password:="STOCK"
  Next pSheet
  For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(3))
    wb.Sheets(c.Value).Range("A" & Rows.Count).End(3)(2).Resize(, 5).Value = c.Offset(, 1).Resize(1, 5).Value
  Next
 
  sh.Range("A2:E500").ClearContents
  For Each pSheet In wb.Sheets
    pSheet.Protect Password:="STOCK", AllowFormattingCells:=True, DrawingObjects:=False, Scenarios:=True
  Next pSheet
  wb.Close SaveChanges:=True
  Application.ScreenUpdating = True
 
  MsgBox "Data Updated Successfully"
End Sub

Thank you So much

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.