J
justagrunt
I'm in the process of automating transfer of data from one xlbook to another.
Now-
Is it possible to open the second xlbook, found in another part of the
server, the sheet range is vertical with a group of cells offset to the
right, which is what has to be copied.
When the two values in both sheets match, the range, which is offset to the
right on the second sheet is copied to the horizontal range in the first
sheet.
The process continues down copying offset ranges from one sheet to the other
when the cell values in both sheets match.
will this work as though the two sheets belong to the same book instead of
being in separate books?
Then
Step down to another matching cell value.
To open the second book I'm using the following
Function Isexcelrunning() As Boolean
'detrmines if and instance of excel is already running
Dim xlapp As Excel.Application
On Error Resume Next
Set xlapp = GetObject(, "excel.application")
Isexcelrunning = (Err.Number = 0)
Set xlapp = Nothing
Err.Clear
End Function
Function TransferInfo()
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim excelrunning As Boolean
excelrunning = Isexcelrunning() ' see above
If excelrunning Then
Set xlapp = GetObject(, "excel.application")
Else
Set xlapp = CreateObject("excel.application")
End If
'open the required excel file
Set xlbook = xlapp.Workbooks.Open(Filename:="C:\Documents and
Settings\billp\Desktop\New Folder\job costings.xls")
'set reference to a worksheet object in the workbook
Set xlsheet = xlbook.Sheets(1)
xlsheet.Activate
'set up parameters and cell ranges
'table in worksheet "job costings" is vertical
'table in worksheet "table" is vertical
'take values form one worksheet and copy to the other worksheet
'close worksheet with reference data
xlbook.Close savechanges:=True
'close microsoft excel and destroy object variables
If Not excelrunning Then xlapp.Quit
Set xlsheet = Nothing
Set xlbook = Nothing
Set xlapp = Nothing
End Function
And I have been successful in the past with a similar code as below to step
vertically copying and pasting horizontally
'table in worksheet(20) is vertical
'table in worksheet(20) is Horizontal
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5
As Range, rng6 As Range, rng20 As Range
Dim cell As Range
Dim res As Variant
Dim z As Variant
Dim c As Variant
Sheet20.Visible = True ' "Five_Market_Union" sheet 20
Set rng20 = Sheet20.Range("F2:F18")
rng20.Clear 'clear the contents of the
cells B4 repasting
Set rng1 = Sheet20.Range("A2:A18") 'Vertical range for Market
Names Sheet (20)
Set rng2 = Sheet20.Range("A22:E22") ' Horizontal Range
For Each cell In rng1
res = "" 'res = some string on sheet 20
res = Application.Match(cell.Value, rng2, 0) ' match string
on sht 20 with something on sht 13
If Not IsError(res) Then
' they match, do something
z = ""
z = cell.Value 'set object from Match function
Set rng3 = Sheet20.Range("A22:E22").Find(what:=z) 'find the value in
sht20
Set rng5 = rng3.Offset(1, 0) '1 cells down 0 cells across
Set rng4 = Sheet20.Range("A2:A18").Find(what:=z) 'find the correct
cell
Set rng6 = rng4.Offset(0, 5) ' 0 cells down 5 cells across
rng5.Copy Destination:=Sheet20.Range(rng6.Address) '.PasteSpecial
' copy the value
'seems to only copy value once to a market and step on
'to the next match - 19/05/06
Else
' they don't match
End If
' continue the search
Next
I am hoping to use a modified match code and want to know if it will be as
easy to use across two workbooks as it is with two sheets in the same
workbook, or will there be a problem with making sheets visible and then
making the next then making it visible again.
Or
Is there an easy way to selectivly copy and paste selected ranges form one
book to another automatically depending on matching values in both worksheets.
Help
Now-
Is it possible to open the second xlbook, found in another part of the
server, the sheet range is vertical with a group of cells offset to the
right, which is what has to be copied.
When the two values in both sheets match, the range, which is offset to the
right on the second sheet is copied to the horizontal range in the first
sheet.
The process continues down copying offset ranges from one sheet to the other
when the cell values in both sheets match.
will this work as though the two sheets belong to the same book instead of
being in separate books?
Then
Step down to another matching cell value.
To open the second book I'm using the following
Function Isexcelrunning() As Boolean
'detrmines if and instance of excel is already running
Dim xlapp As Excel.Application
On Error Resume Next
Set xlapp = GetObject(, "excel.application")
Isexcelrunning = (Err.Number = 0)
Set xlapp = Nothing
Err.Clear
End Function
Function TransferInfo()
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim excelrunning As Boolean
excelrunning = Isexcelrunning() ' see above
If excelrunning Then
Set xlapp = GetObject(, "excel.application")
Else
Set xlapp = CreateObject("excel.application")
End If
'open the required excel file
Set xlbook = xlapp.Workbooks.Open(Filename:="C:\Documents and
Settings\billp\Desktop\New Folder\job costings.xls")
'set reference to a worksheet object in the workbook
Set xlsheet = xlbook.Sheets(1)
xlsheet.Activate
'set up parameters and cell ranges
'table in worksheet "job costings" is vertical
'table in worksheet "table" is vertical
'take values form one worksheet and copy to the other worksheet
'close worksheet with reference data
xlbook.Close savechanges:=True
'close microsoft excel and destroy object variables
If Not excelrunning Then xlapp.Quit
Set xlsheet = Nothing
Set xlbook = Nothing
Set xlapp = Nothing
End Function
And I have been successful in the past with a similar code as below to step
vertically copying and pasting horizontally
'table in worksheet(20) is vertical
'table in worksheet(20) is Horizontal
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5
As Range, rng6 As Range, rng20 As Range
Dim cell As Range
Dim res As Variant
Dim z As Variant
Dim c As Variant
Sheet20.Visible = True ' "Five_Market_Union" sheet 20
Set rng20 = Sheet20.Range("F2:F18")
rng20.Clear 'clear the contents of the
cells B4 repasting
Set rng1 = Sheet20.Range("A2:A18") 'Vertical range for Market
Names Sheet (20)
Set rng2 = Sheet20.Range("A22:E22") ' Horizontal Range
For Each cell In rng1
res = "" 'res = some string on sheet 20
res = Application.Match(cell.Value, rng2, 0) ' match string
on sht 20 with something on sht 13
If Not IsError(res) Then
' they match, do something
z = ""
z = cell.Value 'set object from Match function
Set rng3 = Sheet20.Range("A22:E22").Find(what:=z) 'find the value in
sht20
Set rng5 = rng3.Offset(1, 0) '1 cells down 0 cells across
Set rng4 = Sheet20.Range("A2:A18").Find(what:=z) 'find the correct
cell
Set rng6 = rng4.Offset(0, 5) ' 0 cells down 5 cells across
rng5.Copy Destination:=Sheet20.Range(rng6.Address) '.PasteSpecial
' copy the value
'seems to only copy value once to a market and step on
'to the next match - 19/05/06
Else
' they don't match
End If
' continue the search
Next
I am hoping to use a modified match code and want to know if it will be as
easy to use across two workbooks as it is with two sheets in the same
workbook, or will there be a problem with making sheets visible and then
making the next then making it visible again.
Or
Is there an easy way to selectivly copy and paste selected ranges form one
book to another automatically depending on matching values in both worksheets.
Help