Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copy Value of Active cell and 25 rows above to a diff worksheet
Hello,
I am hoping someone can assist me. My spreadsheets consists of 70 columns and 2000 rows. If my active cell is bx400, I would like to copy value of bx399 into spreadsheet "X"'s cell a9. Then take the value of bx398 and copy that into spreadsheet "X" 's cell ac11, bx397 would be copied to sheet X cell c19 and so on for the previous 25 rows. (This should only be done when I click on the macro button) |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copy Value of Active cell and 25 rows above to a diff worksheet
Here's a macro that should do what you've asked for. You have some work to
do to complete the code: you need to change Const destSheetName = "X" ' change as needed to the actual name of the destination sheet instead of "X", so if your destination sheet's name is Sheet3 it would change to = "Sheet3" Then farther down in the code you have to provide the destination cell addresses for the elements of array cellMap(). I put in the 1st 3 based on your posting, but you need to provide the ones for cellMap(4) through cellMap(25). To put the code into the workbook, open it and press [Alt]+[F11] to open the VB Editor. In it, choose Insert -- Module and then copy the code below and paste it into the module and edit it as required. Then close the VB Editor. To run it later, choose the cell in column BX below the first cell you want to copy and use Tools -- Macro -- Macros and choose it from the list and click [Run]. Or you can put a button or shape on the source sheet and assign the macro to it. Sub CopyFromColumnBX() 'this should be the name of your 'X' sheet 'the sheet to copy from BX into Const destSheetName = "X" ' change as needed Dim destSheet As Worksheet 'this array will hold the addresses of the 'cells on sheet 'X' that the data is to 'be copied into. Dim cellMap(1 To 25) As String Dim LC As Integer ' loop counter If ActiveCell.Column < Range("BX1").Column Then Exit Sub ' not in column BX End If 'if we get here, we have work to do 'fill the array with the destination 'addresses. cellMap(1) = "A9" cellMap(2) = "AC11" cellMap(3) = "C19" 'you need to fill in the rest of the 'destination cell addresses cellMap(4) = "" cellMap(5) = "" cellMap(6) = "" cellMap(7) = "" cellMap(8) = "" cellMap(9) = "" cellMap(10) = "" cellMap(11) = "" cellMap(12) = "" cellMap(13) = "" cellMap(14) = "" cellMap(15) = "" cellMap(16) = "" cellMap(17) = "" cellMap(18) = "" cellMap(19) = "" cellMap(20) = "" cellMap(21) = "" cellMap(22) = "" cellMap(23) = "" cellMap(24) = "" cellMap(25) = "" 'this is where the work actually gets done Set destSheet = _ ThisWorkbook.Worksheets(destSheetName) For LC = LBound(cellMap) To UBound(cellMap) 'safety valve if no address in cellMap() entry If cellMap(LC) < "" Then destSheet.Range(cellMap(LC)) = _ ActiveCell.Offset(LC * -1, 0) End If Next Set destSheet = Nothing ' housekeeping End Sub "ash3154" wrote: Hello, I am hoping someone can assist me. My spreadsheets consists of 70 columns and 2000 rows. If my active cell is bx400, I would like to copy value of bx399 into spreadsheet "X"'s cell a9. Then take the value of bx398 and copy that into spreadsheet "X" 's cell ac11, bx397 would be copied to sheet X cell c19 and so on for the previous 25 rows. (This should only be done when I click on the macro button) |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copy Value of Active cell and 25 rows above to a diff workshee
Thanks for a quick response,
based on this this will only work with column bx, since I have 70 cols, will I have to create a macro for each columns? Messing around, this is what I have come up so far, i just did a test run in 1 column, and seem to work. Option Explicit Sub InsertRows_n_CopyCell() Dim mycell As Range Set mycell = ActiveCell.Offset(0, 0) Dim myrange As Range Set myrange = Range(ActiveCell.Offset(0, 0), mycell) 'Start a Looping procedure Do While ActiveCell.Value = "g" 'Move up 10 rows ActiveCell.Offset(-10).Select Selection.Copy Range("E18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False mycell.Select ActiveCell.Offset(-9).Select Selection.Copy Range("E19").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False mycell.Select ActiveCell.Offset(-8).Select Selection.Copy Range("E20").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("E19").Select Loop End Sub "JLatham" wrote: Here's a macro that should do what you've asked for. You have some work to do to complete the code: you need to change Const destSheetName = "X" ' change as needed to the actual name of the destination sheet instead of "X", so if your destination sheet's name is Sheet3 it would change to = "Sheet3" Then farther down in the code you have to provide the destination cell addresses for the elements of array cellMap(). I put in the 1st 3 based on your posting, but you need to provide the ones for cellMap(4) through cellMap(25). To put the code into the workbook, open it and press [Alt]+[F11] to open the VB Editor. In it, choose Insert -- Module and then copy the code below and paste it into the module and edit it as required. Then close the VB Editor. To run it later, choose the cell in column BX below the first cell you want to copy and use Tools -- Macro -- Macros and choose it from the list and click [Run]. Or you can put a button or shape on the source sheet and assign the macro to it. Sub CopyFromColumnBX() 'this should be the name of your 'X' sheet 'the sheet to copy from BX into Const destSheetName = "X" ' change as needed Dim destSheet As Worksheet 'this array will hold the addresses of the 'cells on sheet 'X' that the data is to 'be copied into. Dim cellMap(1 To 25) As String Dim LC As Integer ' loop counter If ActiveCell.Column < Range("BX1").Column Then Exit Sub ' not in column BX End If 'if we get here, we have work to do 'fill the array with the destination 'addresses. cellMap(1) = "A9" cellMap(2) = "AC11" cellMap(3) = "C19" 'you need to fill in the rest of the 'destination cell addresses cellMap(4) = "" cellMap(5) = "" cellMap(6) = "" cellMap(7) = "" cellMap(8) = "" cellMap(9) = "" cellMap(10) = "" cellMap(11) = "" cellMap(12) = "" cellMap(13) = "" cellMap(14) = "" cellMap(15) = "" cellMap(16) = "" cellMap(17) = "" cellMap(18) = "" cellMap(19) = "" cellMap(20) = "" cellMap(21) = "" cellMap(22) = "" cellMap(23) = "" cellMap(24) = "" cellMap(25) = "" 'this is where the work actually gets done Set destSheet = _ ThisWorkbook.Worksheets(destSheetName) For LC = LBound(cellMap) To UBound(cellMap) 'safety valve if no address in cellMap() entry If cellMap(LC) < "" Then destSheet.Range(cellMap(LC)) = _ ActiveCell.Offset(LC * -1, 0) End If Next Set destSheet = Nothing ' housekeeping End Sub "ash3154" wrote: Hello, I am hoping someone can assist me. My spreadsheets consists of 70 columns and 2000 rows. If my active cell is bx400, I would like to copy value of bx399 into spreadsheet "X"'s cell a9. Then take the value of bx398 and copy that into spreadsheet "X" 's cell ac11, bx397 would be copied to sheet X cell c19 and so on for the previous 25 rows. (This should only be done when I click on the macro button) |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copy Value of Active cell and 25 rows above to a diff workshee
Sorry about that 'bx' thing - but I was going by your problem description
which didn't mention other columns possibly needing to be used. It's still difficult to determine if you can get away with 1 macro or will need 70. It depends mostly on the "mapping" of the source cells to the destination cells and whether the destination sheet is always the same or not. If the destination sheet is always the same, and the destination cells are always the same, then one routine could fit all: we'd just ignore the test to see if we are in column BX or not. You'd only need to delete the If ActiveCell.Column < Range("BX1").Column Then Exit Sub End If statements from the code to allow it to work from any column (but it would assume that the destination cells are the same regardless of which column you currently have selected (and that they are on the same destination sheet). But if the destination cells vary based on what column you have chosen to copy from, then you're probably going to need to add a SELECT CASE block to determine which column you are in and then set up the cell map based on that result. A kind of 70-in-1 solution. "ash3154" wrote: Thanks for a quick response, based on this this will only work with column bx, since I have 70 cols, will I have to create a macro for each columns? Messing around, this is what I have come up so far, i just did a test run in 1 column, and seem to work. Option Explicit Sub InsertRows_n_CopyCell() Dim mycell As Range Set mycell = ActiveCell.Offset(0, 0) Dim myrange As Range Set myrange = Range(ActiveCell.Offset(0, 0), mycell) 'Start a Looping procedure Do While ActiveCell.Value = "g" 'Move up 10 rows ActiveCell.Offset(-10).Select Selection.Copy Range("E18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False mycell.Select ActiveCell.Offset(-9).Select Selection.Copy Range("E19").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False mycell.Select ActiveCell.Offset(-8).Select Selection.Copy Range("E20").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("E19").Select Loop End Sub "JLatham" wrote: Here's a macro that should do what you've asked for. You have some work to do to complete the code: you need to change Const destSheetName = "X" ' change as needed to the actual name of the destination sheet instead of "X", so if your destination sheet's name is Sheet3 it would change to = "Sheet3" Then farther down in the code you have to provide the destination cell addresses for the elements of array cellMap(). I put in the 1st 3 based on your posting, but you need to provide the ones for cellMap(4) through cellMap(25). To put the code into the workbook, open it and press [Alt]+[F11] to open the VB Editor. In it, choose Insert -- Module and then copy the code below and paste it into the module and edit it as required. Then close the VB Editor. To run it later, choose the cell in column BX below the first cell you want to copy and use Tools -- Macro -- Macros and choose it from the list and click [Run]. Or you can put a button or shape on the source sheet and assign the macro to it. Sub CopyFromColumnBX() 'this should be the name of your 'X' sheet 'the sheet to copy from BX into Const destSheetName = "X" ' change as needed Dim destSheet As Worksheet 'this array will hold the addresses of the 'cells on sheet 'X' that the data is to 'be copied into. Dim cellMap(1 To 25) As String Dim LC As Integer ' loop counter If ActiveCell.Column < Range("BX1").Column Then Exit Sub ' not in column BX End If 'if we get here, we have work to do 'fill the array with the destination 'addresses. cellMap(1) = "A9" cellMap(2) = "AC11" cellMap(3) = "C19" 'you need to fill in the rest of the 'destination cell addresses cellMap(4) = "" cellMap(5) = "" cellMap(6) = "" cellMap(7) = "" cellMap(8) = "" cellMap(9) = "" cellMap(10) = "" cellMap(11) = "" cellMap(12) = "" cellMap(13) = "" cellMap(14) = "" cellMap(15) = "" cellMap(16) = "" cellMap(17) = "" cellMap(18) = "" cellMap(19) = "" cellMap(20) = "" cellMap(21) = "" cellMap(22) = "" cellMap(23) = "" cellMap(24) = "" cellMap(25) = "" 'this is where the work actually gets done Set destSheet = _ ThisWorkbook.Worksheets(destSheetName) For LC = LBound(cellMap) To UBound(cellMap) 'safety valve if no address in cellMap() entry If cellMap(LC) < "" Then destSheet.Range(cellMap(LC)) = _ ActiveCell.Offset(LC * -1, 0) End If Next Set destSheet = Nothing ' housekeeping End Sub "ash3154" wrote: Hello, I am hoping someone can assist me. My spreadsheets consists of 70 columns and 2000 rows. If my active cell is bx400, I would like to copy value of bx399 into spreadsheet "X"'s cell a9. Then take the value of bx398 and copy that into spreadsheet "X" 's cell ac11, bx397 would be copied to sheet X cell c19 and so on for the previous 25 rows. (This should only be done when I click on the macro button) |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copy Value of Active cell and 25 rows above to a diff workshee
I am sorry, I got pulled into something, I will work on this as soon as I get
back on this project. Thanks, Ash "JLatham" wrote: Sorry about that 'bx' thing - but I was going by your problem description which didn't mention other columns possibly needing to be used. It's still difficult to determine if you can get away with 1 macro or will need 70. It depends mostly on the "mapping" of the source cells to the destination cells and whether the destination sheet is always the same or not. If the destination sheet is always the same, and the destination cells are always the same, then one routine could fit all: we'd just ignore the test to see if we are in column BX or not. You'd only need to delete the If ActiveCell.Column < Range("BX1").Column Then Exit Sub End If statements from the code to allow it to work from any column (but it would assume that the destination cells are the same regardless of which column you currently have selected (and that they are on the same destination sheet). But if the destination cells vary based on what column you have chosen to copy from, then you're probably going to need to add a SELECT CASE block to determine which column you are in and then set up the cell map based on that result. A kind of 70-in-1 solution. "ash3154" wrote: Thanks for a quick response, based on this this will only work with column bx, since I have 70 cols, will I have to create a macro for each columns? Messing around, this is what I have come up so far, i just did a test run in 1 column, and seem to work. Option Explicit Sub InsertRows_n_CopyCell() Dim mycell As Range Set mycell = ActiveCell.Offset(0, 0) Dim myrange As Range Set myrange = Range(ActiveCell.Offset(0, 0), mycell) 'Start a Looping procedure Do While ActiveCell.Value = "g" 'Move up 10 rows ActiveCell.Offset(-10).Select Selection.Copy Range("E18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False mycell.Select ActiveCell.Offset(-9).Select Selection.Copy Range("E19").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False mycell.Select ActiveCell.Offset(-8).Select Selection.Copy Range("E20").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("E19").Select Loop End Sub "JLatham" wrote: Here's a macro that should do what you've asked for. You have some work to do to complete the code: you need to change Const destSheetName = "X" ' change as needed to the actual name of the destination sheet instead of "X", so if your destination sheet's name is Sheet3 it would change to = "Sheet3" Then farther down in the code you have to provide the destination cell addresses for the elements of array cellMap(). I put in the 1st 3 based on your posting, but you need to provide the ones for cellMap(4) through cellMap(25). To put the code into the workbook, open it and press [Alt]+[F11] to open the VB Editor. In it, choose Insert -- Module and then copy the code below and paste it into the module and edit it as required. Then close the VB Editor. To run it later, choose the cell in column BX below the first cell you want to copy and use Tools -- Macro -- Macros and choose it from the list and click [Run]. Or you can put a button or shape on the source sheet and assign the macro to it. Sub CopyFromColumnBX() 'this should be the name of your 'X' sheet 'the sheet to copy from BX into Const destSheetName = "X" ' change as needed Dim destSheet As Worksheet 'this array will hold the addresses of the 'cells on sheet 'X' that the data is to 'be copied into. Dim cellMap(1 To 25) As String Dim LC As Integer ' loop counter If ActiveCell.Column < Range("BX1").Column Then Exit Sub ' not in column BX End If 'if we get here, we have work to do 'fill the array with the destination 'addresses. cellMap(1) = "A9" cellMap(2) = "AC11" cellMap(3) = "C19" 'you need to fill in the rest of the 'destination cell addresses cellMap(4) = "" cellMap(5) = "" cellMap(6) = "" cellMap(7) = "" cellMap(8) = "" cellMap(9) = "" cellMap(10) = "" cellMap(11) = "" cellMap(12) = "" cellMap(13) = "" cellMap(14) = "" cellMap(15) = "" cellMap(16) = "" cellMap(17) = "" cellMap(18) = "" cellMap(19) = "" cellMap(20) = "" cellMap(21) = "" cellMap(22) = "" cellMap(23) = "" cellMap(24) = "" cellMap(25) = "" 'this is where the work actually gets done Set destSheet = _ ThisWorkbook.Worksheets(destSheetName) For LC = LBound(cellMap) To UBound(cellMap) 'safety valve if no address in cellMap() entry If cellMap(LC) < "" Then destSheet.Range(cellMap(LC)) = _ ActiveCell.Offset(LC * -1, 0) End If Next Set destSheet = Nothing ' housekeeping End Sub "ash3154" wrote: Hello, I am hoping someone can assist me. My spreadsheets consists of 70 columns and 2000 rows. If my active cell is bx400, I would like to copy value of bx399 into spreadsheet "X"'s cell a9. Then take the value of bx398 and copy that into spreadsheet "X" 's cell ac11, bx397 would be copied to sheet X cell c19 and so on for the previous 25 rows. (This should only be done when I click on the macro button) |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro to copy active worksheet to new workbook | Excel Discussion (Misc queries) | |||
copy active cell value,find the pasted value in different worksheet | Excel Worksheet Functions | |||
Using a cell reference to copy rows to a new worksheet | Excel Discussion (Misc queries) | |||
how do i copy rows to a new worksheet by a cell value | New Users to Excel | |||
hpw do I logic test a cell then copy the row to diff. SS | Excel Worksheet Functions |