View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel[_616_] joel[_616_] is offline
external usenet poster
 
Posts: 1
Default Copying Sheets to a woekbook


Since the file structure of all office products are the same you can get
data from an excel spreadsheet just like you would an Access Database.
do a search for ADO method Excel.

There are some slight differences in naming conventions. the ADO
method requires you do put a dollar sign at the end of each sheet name.

Below is code I wrote for somebody a couple of months ago. the code
create a SQL string to get the data and it even filters the sheet using
a person name. You can leave off the persons name in the SQL.




Sub MoveData()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Set sourcesht = ThisWorkbook.Sheets("Sheet1")
Folder = "c:\Temp\"
DestFile = Folder & "Activity overview1.xls"
'excel worksheet must have dollar sign at end of name
DestShtName = "Sheet1" & "$"

With sourcesht
Person = .Range("A1")
EstWorkLoad = .Range("C4")
RealWorkLoad = .Range("C5")
WeekNum = .Range("F2")
End With

'open a connection, doesn't open the file
Set cn = New ADODB.Connection

With cn

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DestFile & ";" & _
"Mode=Share Deny None;" & _
"Extended Properties=""Excel 8.0;HDR=No;ReadOnly=False;"""

Open (ConnectStr)
End With

'open the recordset
Set rs = New ADODB.Recordset
With rs

MySQL = "SELECT * FROM [" & DestShtName & "] "

Open Source:=MySQL, _
ActiveConnection:=cn

If .EOF < True Then

RowCount = 1
Do While Not .EOF And RowCount < 14

MoveNext
RowCount = RowCount + 1
Loop

If .EOF Then
MsgBox ("Not Enough Rows - Exit macro")
End If

setLoad = ""

WorkWeekCol = 0
WorkWeek = 22
For Each Fld In rs.Fields
If Fld.Value = WorkWeek Then
'rows and columns are backwards from excel
WorkWeekCol = Range(Fld.Name).Row
Exit For
End If
Next Fld
End If

If WorkWeekCol = 0 Then
MsgBox ("Did not find WorkWeek : " & WorkWeek & ". Exiting
Macro")
Exit Sub
End If

Close

Person = "Joel"

MySQL = "SELECT *" & vbCrLf & _
"FROM [" & DestShtName & "] " & vbCrLf & _
"Where [" & DestShtName & ".F1]='" & Person & "'"

Open Source:=MySQL, _
ActiveConnection:=cn, _
LockType:=adLockOptimistic, _
CursorType:=adCmdTable

If .EOF = True Then
MsgBox ("count not find : " & Person & " Exit Macro")
Exit Sub
Else

EstWorkLoad = 123
RealWorkLoad = 456
'field start at zero, subtract one from index
Fields(WorkWeekCol - 1).Value = EstWorkLoad
Fields(WorkWeekCol).Value = RealWorkLoad
Update
End If


End With

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=174932

Microsoft Office Help