Very useful code for taking data from an Excel Worksheet and Insert it into a SQL Server Table.
I could not find a complete solution so I am posting one
Key Words: SQL INSERT VBA DATABASE
I could not find a complete solution so I am posting one

Key Words: SQL INSERT VBA DATABASE
Code:
Sub CreateInsertScript()
Dim Row As Integer
Dim Col As Integer
Dim conn As ADODB.Connection
Dim statement As String
' Create a connection object.
Dim cnPubs As ADODB.Connection
Set cnPubs = New ADODB.Connection
' Provide the connection string.
Dim strConn As String
'Use the SQL Server OLE DB Provider.
strConn = "PROVIDER=SQLOLEDB;"
'Connect to the Pubs database on the local server.
strConn = strConn & "DATA SOURCE=SQL00099T95;INITIAL CATALOG=TestMetrics;"
'Use an integrated login.
strConn = strConn & " INTEGRATED SECURITY=sspi;"
'Now open the connection.
cnPubs.Open strConn
'----------------------------------------------------
'----------------------------------------------------
' Create the Excel application.
Set excel_app = CreateObject("Excel.Application")
'----------------------------------------------------
'----------------------------------------------------
'To store all the columns available in the current active sheet
Dim ColNames(100) As String
Col = 1
Row = 1
Dim ColCount As Integer
ColCount = 0
'Get Columns from the sheet
Do Until ActiveSheet.Cells(Row, Col) = "" 'Loop until you find a blank.
ColNames(ColCount) = "[" + ActiveSheet.Cells(Row, Col) + "]"
ColCount = ColCount + 1
Col = Col + 1
Loop
ColCount = ColCount - 1
'Inputs for the starting and ending point for the rows
Row = InputBox("Give the starting Row No.")
Dim MaxRow As Integer
MaxRow = InputBox("Give the Maximum Row No.")
Dim CellColCount As Integer
Dim StringStore As String 'Temporary variable to store partial statement
Dim SQL_statement As String
Do While Row <= MaxRow
StringStore = ""
CellColCount = 0
'ActiveSheet.Name will give the current active sheet name
'this can be treated as table name in the database
StringStore = StringStore + "insert into TestMetrics.dbo.test ( "
Do While CellColCount <= ColCount
StringStore = StringStore + ColNames(CellColCount)
'To avoid "," after last column
If CellColCount <> ColCount Then
StringStore = StringStore + " , "
End If
CellColCount = CellColCount + 1
Loop
'Here it will create "insert into [TableName] ( [Col1] , [Col2] , ..."
SQL_statement = StringStore + " ) "
'For printing the values for the above columns
StringStore = " values( "
CellColCount = 0
Do While CellColCount <= ColCount
StringStore = StringStore + " '" + CStr(ActiveSheet.Cells(Row, CellColCount + 1)) + "'"
If CellColCount <> ColCount Then
StringStore = StringStore + ", "
End If
CellColCount = CellColCount + 1
Loop
'Here it will print "values( 'value1', 'value2', ..."
SQL_statement = SQL_statement & StringStore & ");"
'MsgBox SQL_statement
' Create a recordset object.
Dim rsPubs As ADODB.Recordset
Set rsPubs = New ADODB.Recordset
'----------------------------------------------------
'----------------------------------------------------
'Run Your SQL Command :)
With rsPubs
' Assign the Connection object.
.ActiveConnection = cnPubs
' Extract the required records.
'for a query change it to .Open "INSERT T-SQL"
.Open SQL_statement
End With
Row = Row + 1
Loop
'Close up your database connection
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing
End Sub