Code peerer needed


Board Regular
Apr 3, 2017
I've been using a VBA script which was kindly made by DMT32, but I just have a query around something additional it might be able to do with a small change.

It uploads data from a line into a table, and I've noticed that you can do it from another sheet in the same book to a different table - but the source data it moves still comes from sheet1.

Is there any way to easily adjust so that it uploads the data depending on what sheet your on? It'd be great to be able to upload different data to a different table in the same book.

Sub SaveTemplateData()
'dmt32 - May 2017
    Dim DatabasePassword As String, TemplateSheet As String
    Dim wbDatabase As Workbook, wbTemplate As Workbook
    Dim DatabaseRange As Range, DataEntryRange As Range, Item As Range
    Dim DatabaseName As Variant, msg As Variant, Data() As Variant
    Dim i As Integer, InputCellCount As Integer
    Dim CompleteAllCells As Boolean

'Database workbook open password - enter as required (case sensitive)
    DatabasePassword = ""
'Template Input Addresses
'cells can be both contiguous & non-contiguous
    TemplateInputAddress = "B118:BM118"
'data entry rules (Set True if ALL Cells must be completed)
    CompleteAllCells = False

'Database Path / Name
    DatabaseName = Cells(Rows.Count, 1).Value

    If Len(DatabaseName) = 0 Then
        DatabaseName = BrowseFile
        If DatabaseName = False Then Exit Sub
        Cells(Rows.Count, 1).Value = DatabaseName
    End If

    On Error GoTo myerror
'check file / folder path valid
    If Not Dir(DatabaseName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False
        Set wbTemplate = ThisWorkbook
'data entry range
        Set DataEntryRange = wbTemplate.Worksheets(1).Range(TemplateInputAddress)
'count No Input Cells
    InputCellCount = DataEntryRange.Cells.Count
    For Each Item In DataEntryRange.Cells
'check if required entry for all cells
        If CompleteAllCells And Len(Item.Value) = 0 Then
            MsgBox "Please Complete All Fields.", 16, "Entry Required"
            Exit Sub
        End If
'build array
        i = i + 1
        ReDim Preserve Data(1 To i)
'data values to array
    If IsDate(Item.Text) Then
        Data(i) = DateValue(Item.Text)
        Data(i) = Item.Value
    End If
    Next Item
'or if some blank cells allowed, check if any data entered
    If Not CompleteAllCells And Application.CountA(Range(TemplateInputAddress)) = 0 Then
        MsgBox "All Fields Are Empty.", 16, "Error"
    Exit Sub
    End If
'Open database
        Set wbDatabase = Workbooks.Open(DatabaseName, ReadOnly:=False, Password:=DatabasePassword)
'Next empty range in database
        With wbDatabase.Sheets(1)
            Set DatabaseRange = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
        End With

'output array to database range
        DatabaseRange.Resize(1, InputCellCount).Value = Data
'close & save
        wbDatabase.Close True
'clear form
'report success
        msg = Array("Template Data Saved", "Data Saved")
'report problem
        msg = Array(DatabaseName & Chr(10) & "File Not Found", "Error")
    End If
    Application.ScreenUpdating = True
    If Err > 0 Then
        If Not wbDatabase Is Nothing Then wbDatabase.Close False
        MsgBox (Error(Err)), 48, "Error"
        MsgBox msg(0), 48, msg(1)
    End If
'clean up
    Set wbDatabase = Nothing
    Set wbTemplate = Nothing
    Set DataEntryRange = Nothing
End Sub
Last edited:

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)


Well-known Member
Jun 2, 2016
This line:

Set DataEntryRange = wbTemplate.Worksheets(1).Range(TemplateInputAddress)

Forces the data to come from the first sheet in the workbook. You could try changing it to :

Set DataEntryRange = Range(TemplateInputAddress)

Which should use the data from the active sheet instead.


Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back