Sub AppendData()
Dim sConn As String, sSQL As String
Dim rst As ADODB.Recordset, cnn As ADODB.Connection
Dim sPath As String, sDB As String
Dim sh As Range, lRow As Long, wsData As Worksheet
'[b]the workbook I am opening is in the same folder as the ThisWorkbook [/b]
sPath = ThisWorkbook.Path
sDB = "Backup July 2006 (Week 5)"
Set cnn = New ADODB.Connection
sConn = "Provider=MSDASQL.1;"
sConn = sConn & "Persist Security Info=False;"
sConn = sConn & "Extended Properties=""DSN=Excel Files;"
sConn = sConn & "DBQ=" & sPath & "\" & sDB & ".xls;"
sConn = sConn & "DefaultDir=" & sPath & ";"
sConn = sConn & "DriverId=790;MaxBufferSize=2048;PageTimeout=5;"""
cnn.Open sConn
Set rst = New ADODB.Recordset
For Each sh In [SheetName]
'[b]this SQL code will be specific to your requirements[/b]
sSQL = "SELECT A.PN"
sSQL = sSQL & ", A.RQDATE"
sSQL = sSQL & ", A.QTY"
sSQL = sSQL & ", A.COST"
sSQL = sSQL & ", A.NOMEN"
sSQL = sSQL & ", A.`GROUP`"
sSQL = sSQL & ", A.`Late Pieces`"
sSQL = sSQL & ", A.BackLog "
'[b]the sheet name followed by a DOLLAR SIGN[/b]
sSQL = sSQL & "FROM `" & sPath & "\" & sDB & "`.`" & sh.Value & "$` A "
sSQL = sSQL & "WHERE (A.`Late Pieces`>0 OR A.BackLog>0) "
sSQL = sSQL & " AND (A.COE='DSC') "
[Sql] = sSQL
With rst
.Open sSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText
With wsData
lRow = .UsedRange.Rows.Count + 1
.Cells(lRow, 1).CopyFromRecordset rst
.Range(.Cells(lRow, .UsedRange.Columns.Count), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value = sh.Value
End With
.Close
End With
Next
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub