Take your career to the next level with convenient certification training. Start your 7-day Free Trial
Experts Exchange Solution brought to you by
"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.
'151116 modified by strive4peace
On Error GoTo Proc_Err
Dim wsDB As Worksheet
Dim wbDB As Workbook
Dim wsConsolidate As Worksheet
Dim wbConsolidate As Workbook
Dim lngNextRowDB As Long
Dim lngNextRowConsolidate As Long
Dim lngRowDB1 As Long
Dim lngRowDB2 As Long
Dim lngLastRowData As Long
Dim lngRow As Long
Dim sPathFile As String
sPathFile = "C:\Users\pike\Desktop\114Database\Consolidate.xlsm" '--- customize this
' this workbook has a sheet called: ConsolidatedDB
If MsgBox("Transfer data to Main, clear all input and start again with Skid #1" _
, vbYesNo + vbDefaultButton2, "Warning") <> vbYes Then
Application.EnableEvents = False
lngNextRowDB = Sheets("DB").Cells(Rows.Count, 1).End(xlUp).Row + 1
lngRowDB1 = lngNextRowDB
Set wbDB = ActiveWorkbook
Set wsDB = Sheets("DB")
lngLastRowData = .Range("C1048576").End(xlUp).Row
' .Range("C4:J" & lngLastRowData).Copy Destination:=wsDB.Cells(lngNextRowDB, "A")
For lngRow = 4 To lngLastRowData
If .Cells(lngRow, "C") <> "" Then
wsDB.Cells(lngNextRowDB, "A") = .Cells(lngRow, "C")
wsDB.Cells(lngNextRowDB, "B") = .Cells(lngRow, "D")
wsDB.Cells(lngNextRowDB, "C") = .Cells(lngRow, "E")
wsDB.Cells(lngNextRowDB, "D") = .Cells(lngRow, "F")
wsDB.Cells(lngNextRowDB, "E") = .Cells(lngRow, "G")
wsDB.Cells(lngNextRowDB, "F") = .Cells(lngRow, "H")
wsDB.Cells(lngNextRowDB, "G") = .Cells(lngRow, "J")
lngNextRowDB = lngNextRowDB + 1
lngRowDB2 = lngNextRowDB - 1
'open external workbook
Set wbConsolidate = Workbooks.Open(sPathFile)
Set wsConsolidate = wbConsolidate.Sheets("ConsolidatedDB")
lngNextRowConsolidate = wsConsolidate.Cells(Rows.Count, 1).End(xlUp).Row + 1
'copy data from the DB sheet that was just added
Application.CutCopyMode = False
.Range("A" & lngRowDB1 & ":G" & lngRowDB2).Copy
'switch to the consolidated workbook and paste
'close the other workbook and save the changes
MsgBox "Done consolidating data", , "Done"
On Error Resume Next
'release object variables
'delete data on the input sheet
.Range(.Cells(4, 1), .Cells(4, 1).SpecialCells(xlLastCell)).ClearContents
Set wsConsolidate = Nothing
Set wsDB = Nothing
Set wbDB = Nothing
Set wbConsolidate = Nothing
Application.EnableEvents = True
ActiveSheet.Protect Password:="Scan", DrawingObjects:=True, UserInterfaceOnly:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Application.EnableEvents = True
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " SendToDB"
Open in new window
This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.
Worksheets("Data").Visible = xlSheetHidden
Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.
From novice to tech pro — start learning today.
Premium members can enroll in this course at no extra cost.
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
Please enter a first name
Please enter a last name
Must be at least 4 characters long.
Join and Comment