Hi folks,
I would like to replace number references to the last column and row with LastColumn and LastRow, to accommodate tables, which differ in size..
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
As background to my situation. I have a spreadsheet, which contains a big table from which stats tables are generated. These use some lengthy formula and the whole spreadsheet is quite hefty. I am moving the values across to a second spreadsheet, which contains some further simple formula, therefore I do not need to copy across the whole of each table. The result is that I have a spreadsheet, which is more manageable.
<o></o>
I would like to change the column and row references in the three lines below so that I do not have to alter the coding each time I reuse the macro to move a different table
<o></o>
Set DestHder = DestSh.Range(DestCell.Offset(0, 0), DestCell.Offset(0, 4))
Set SourceRng = SourceSh.Range(SourceCell.Offset(1, 0), SourceCell.Offset(8, 0))
Set DestRng = DestSh.Range(DestCell.Offset(1, 0), DestCell.Offset(8, 0))
<o></o>
Here is the full code that I am using
<o></o>
Sub TransferDataToDifferentWorkbook()
'This macro enables values only to be copied across into another workbook.
'Must have workbook, where data is to be put(Destination), as active workbook
'Must enter the Source workbook file name and
'Must enter the both source and destination anchor cell reference into the code
'The 'anchor' cells are the cells from which all the code operates
' Hooray - this works
Dim SourceCell As Range, DestCell As Range, DestHder As Range
Dim SourceRng As Range, DestRng As Range
Dim SourceSh As Worksheet, DestSh As Worksheet
Dim WkBkSource As Workbook, WkBkDest As Workbook
<o></o>
Set WkBkSource = Workbooks("Book1.xls") 'to be changed to match required file name
Set WrBkDest = ActiveWorkbook
Set SourceSh = WkBkSource.Sheets("Sheet1")
Set DestSh = WrBkDest.Sheets("Table 1.1")
Set SourceCell = SourceSh.Range("B2") 'to be changed to refer to anchor cell in Source table
Set DestCell = DestSh.Range("D2") 'to be changed to refer to anchor cell in Destination table
Set DestHder = DestSh.Range(DestCell.Offset(0, 0), DestCell.Offset(0, 4))
Set SourceRng = SourceSh.Range(SourceCell.Offset(1, 0), SourceCell.Offset(8, 0))
Set DestRng = DestSh.Range(DestCell.Offset(1, 0), DestCell.Offset(8, 0))
<o></o>
DestSh.Activate
' check to ensure correct workbook and sheet is active
If Range("A1").Value = "T1.1" Then
For Each Cell In DestHder
If Cell.Value = "No." Then
'copy values across from Source to Dest
DestRng.Value = SourceRng.Value
'reset Source and Dest ranges
Set SourceRng = SourceRng.Offset(0, 1)
Set DestRng = DestRng.Offset(0, 1)
Else
'no need for code as nothing to transfer
'reset Source and Dest ranges
Set SourceRng = SourceRng.Offset(0, 1)
Set DestRng = DestRng.Offset(0, 1)
End If
On Error Resume Next
Next
Else
MsgBox "Must have destination workbook open"
Exit Sub
End If
End Sub
<o></o>
Hopefully this is clear. Apologies if I have messed up with some of the terminology
<o></o>
Looking forward with hope.
Dbus
Enthusiastic Amateur
I would like to replace number references to the last column and row with LastColumn and LastRow, to accommodate tables, which differ in size..
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
As background to my situation. I have a spreadsheet, which contains a big table from which stats tables are generated. These use some lengthy formula and the whole spreadsheet is quite hefty. I am moving the values across to a second spreadsheet, which contains some further simple formula, therefore I do not need to copy across the whole of each table. The result is that I have a spreadsheet, which is more manageable.
<o></o>
I would like to change the column and row references in the three lines below so that I do not have to alter the coding each time I reuse the macro to move a different table
<o></o>
Set DestHder = DestSh.Range(DestCell.Offset(0, 0), DestCell.Offset(0, 4))
Set SourceRng = SourceSh.Range(SourceCell.Offset(1, 0), SourceCell.Offset(8, 0))
Set DestRng = DestSh.Range(DestCell.Offset(1, 0), DestCell.Offset(8, 0))
<o></o>
Here is the full code that I am using
<o></o>
Sub TransferDataToDifferentWorkbook()
'This macro enables values only to be copied across into another workbook.
'Must have workbook, where data is to be put(Destination), as active workbook
'Must enter the Source workbook file name and
'Must enter the both source and destination anchor cell reference into the code
'The 'anchor' cells are the cells from which all the code operates
' Hooray - this works
Dim SourceCell As Range, DestCell As Range, DestHder As Range
Dim SourceRng As Range, DestRng As Range
Dim SourceSh As Worksheet, DestSh As Worksheet
Dim WkBkSource As Workbook, WkBkDest As Workbook
<o></o>
Set WkBkSource = Workbooks("Book1.xls") 'to be changed to match required file name
Set WrBkDest = ActiveWorkbook
Set SourceSh = WkBkSource.Sheets("Sheet1")
Set DestSh = WrBkDest.Sheets("Table 1.1")
Set SourceCell = SourceSh.Range("B2") 'to be changed to refer to anchor cell in Source table
Set DestCell = DestSh.Range("D2") 'to be changed to refer to anchor cell in Destination table
Set DestHder = DestSh.Range(DestCell.Offset(0, 0), DestCell.Offset(0, 4))
Set SourceRng = SourceSh.Range(SourceCell.Offset(1, 0), SourceCell.Offset(8, 0))
Set DestRng = DestSh.Range(DestCell.Offset(1, 0), DestCell.Offset(8, 0))
<o></o>
DestSh.Activate
' check to ensure correct workbook and sheet is active
If Range("A1").Value = "T1.1" Then
For Each Cell In DestHder
If Cell.Value = "No." Then
'copy values across from Source to Dest
DestRng.Value = SourceRng.Value
'reset Source and Dest ranges
Set SourceRng = SourceRng.Offset(0, 1)
Set DestRng = DestRng.Offset(0, 1)
Else
'no need for code as nothing to transfer
'reset Source and Dest ranges
Set SourceRng = SourceRng.Offset(0, 1)
Set DestRng = DestRng.Offset(0, 1)
End If
On Error Resume Next
Next
Else
MsgBox "Must have destination workbook open"
Exit Sub
End If
End Sub
<o></o>
Hopefully this is clear. Apologies if I have messed up with some of the terminology
<o></o>
Looking forward with hope.
Dbus
Enthusiastic Amateur