Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copying Sheets to a woekbook
Is there a method for copying sheets from a workbook that is not open to a
workbook that is? I have written a vba that lets a user select a number of workbooks (.FindFile method) that will open them, copy the tab (worksheet) of each workbook to the end of the target workbook, rename the new tab to the name of the file it came from, and then close the workbook. It would go a lot faster if I could get the tab from the workbook without opening it. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copying Sheets to a woekbook
Thanks Joel- I need to digest what you presented and see which lines are
pertinent to my situation. "joel" wrote: 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 . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copying Sheets | Excel Discussion (Misc queries) | |||
Copying sheets without copying named ranges | Excel Programming | |||
Copying Sheets | Excel Programming | |||
Copying Sheets | Excel Programming | |||
Copying sheets | Excel Programming |