I have a sheet that requests a user to enter data and then click a button to save the data into the database. The database is currently located in the same workbook “Different worksheet”.
What i basically need is for this data to be saved on a different worksheet that i call “Consolidated.xlsx” which is available in a different folder “C:/reports/consolidates.xlsx” so that only I can access this data and no one else
Please let me know if you can help
Document currently available under the following link:
EDIT 4/19: the code below has been updated to write to the local “PartsData” sheet as well as the consolidated target… You still need to make sure there is a sheet on your “consolidated” file that is named “PartsData”:
Option Explicit Sub UpdateLogWorksheet() Dim historyWks As Worksheet, localWks As Worksheet, _ inputWks As Worksheet, indexWks As Worksheet Dim historyWb As Workbook Dim MyWorksheets As New Collection Dim nextRow As Long, oCol As Long Dim myRng As Range, myCell As Range Dim myCopy As String 'cells to copy from Input sheet - some contain formulas myCopy = "D5,D7,D9,D11,D13" 'assign variables for easy reference Set inputWks = ThisWorkbook.Worksheets("Input") Set localWks = ThisWorkbook.Worksheets("PartsData") Set historyWb = Workbooks.Open("C:\reports\consolidated.xlsx") Set historyWks = historyWb.Worksheets("PartsData") 'put both target worksheets into a collection for an easy loop MyWorksheets.Add Item:=localWks MyWorksheets.Add Item:=historyWks With historyWks nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row End With With inputWks Set myRng = .Range(myCopy) If Application.CountA(myRng) <> myRng.Cells.Count Then MsgBox "Please fill in all the cells!" Exit Sub End If End With 'write results of form to both local parts data and consolidated parts data For Each indexWks In MyWorksheets With indexWks With .Cells(nextRow, "A") .Value = Now .NumberFormat = "mm/dd/yyyy hh:mm:ss" End With .Cells(nextRow, "B").Value = Application.UserName oCol = 3 For Each myCell In myRng.Cells indexWks.Cells(nextRow, oCol).Value = myCell.Value oCol = oCol + 1 Next myCell End With Next indexWks historyWb.Save '<~ save and close the target workbook historyWb.Close SaveChanges:=False 'clear input cells that contain constants With inputWks On Error Resume Next With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants) .ClearContents Application.GoTo .Cells(1) ', Scroll:=True End With On Error GoTo 0 End With End Sub