Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro to copy contents of active cell

Status
Not open for further replies.

Davidliz99

Technical User
Apr 30, 2009
4
US
I have an excel list of things that I use for my job. The "master" list is about 200 or so items long. I use this list to create another list of things that are important at this moment. I would like to be able to click the cell of a desired item, and when the cell is selected, the contents of the cell would automatically be copied and pasted into sheet 2. I have tried to use the macro recorder in excel, and it copies the entire list, unfortunately. For example, if I have a list that is peter, paul, mary, joe and john, and I click peter and john. I would like to copy and paste peter and john into another worksheet with out having to ctrl c and ctrl v so much. Any help would be great. Thanks.
 
Here's one way:


Sub CopySelected()
Dim Selected As Variant

Selected = Selection.Value

Range("sheet2!A1:A2").Value = Selected
End Sub

Do you want the data to be copied into a fixed range, or onto the end of a list, or what?
 
David,

I assume that,
the sheet with all data is named sheet1
the sheet with the results is named sheet2

You can add VBA code to the sheet1 (Go to VBA Editor, then double click Sheet1 on the project explorer)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim start As String
Dim final As String
Dim DestinationSheet As String
Dim DestinationRow As Long
Dim DestinationColumn As Long

'Start and final determines the main interval of data, change if necessary
start = "A2"
final = "A9"
DestinationSheet = "Sheet2"
' Destination list starts at A2. Change tehe column and row if necessary
DestinationColumn = 1
DestinationRow = 2

' if A2 is not empty then it will find first empty row
If Worksheets(DestinationSheet).Cells(DestinationRow, DestinationColumn).Value <> "" Then
If Worksheets(DestinationSheet).Cells(DestinationRow + 1, DestinationColumn).Value <> "" Then
DestinationRow = Worksheets(DestinationSheet).Cells(DestinationRow, DestinationColumn).End(xlDown).Row + 1
Else
DestinationRow = DestinationRow + 1
End If
End If

If Target.Row >= Range(start).Row And Target.Column >= Range(start).Column And _
Target.Row <= Range(final).Row And Target.Column <= Range(final).Column Then

Worksheets(DestinationSheet).Cells(DestinationRow, DestinationColumn).Value = ActiveCell.Value
DestinationRow = DestinationRow + 1
End If

End Sub

Make the necessary changes of the intervals and the names of the sheets.



Carlos César tanaka
Curso de Excel / Access
MPR Informática
 



Hi,

You certainly did not supply enough info to give you a good answer...
Code:
sub CopyValue()
  [b]SomeOtherSheetObject.SomeOtherCellObject[/b].value = Activecell.value
end sub
so we need to know the other sheet and the logic for the other cell where you want the value to be.

Skip,
[sup][glasses]Don't let the Diatribe...
talk you to death![tongue][/sup][sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thanks to all who replied, I really appreciate the help.

If you couldn't tell, I don't know what I'm doing, but I'm trying. I've googled each line of code above to try to understand the commands better and hopefully understand what I need to change to get my application to work right, and I found a ton of info, but I still don't understand.

SkipVought,
I don't know what you mean when you say "logic for the other cell where you want the value to be".

cctanaka,
I've tried changing the names around in your code, but I get errors saying the subscript is out of range, or a syntax error when I try to "find and replace" destinationsheet etc...

I have made a simple grocery list at home and typed it up so that I could have something to apply your responses to, and I wanted to attach the excel file, but the attachment button below appears to accept only addresses, not files. Is that right?

I have to use this a lot, and a couple of other people who do mostly labor also use this, so I'm trying to simplify the process as much as possible for them. Many of them are unwilling to hold the ctrl key and click several items at once, they won't use the keyboard shortcuts etc., I don't know why they are like that but... I'd really appreciate the help.

 


SkipVought,
I don't know what you mean when you say "logic for the other cell where you want the value to be".

Logic:
1. a SPECIFIC reference.
2. at the top of some range
3. at the bottom of some range
4 to the left of some range
5. to the right of some range
et cetera......

WHERE does the result go??????

Skip,
[sup][glasses]Don't let the Diatribe...
talk you to death![tongue][/sup][sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
The result would go to Sheet2, cell A1, the next item to A2, the next to A3 and so on. It would be typical for the results to go down to A60 or so. Sheet1 would need to include a range from A1 to about A400, just to include a little head room for growth if that makes sense. Also, is it possible to copy the contents of the Sheet1 B column to the B column on sheet2 as well with a single click? The B column on my sheet1 contains inventory locations that define where things are within our facility. It would be nice to copy that as well with one click, that way, the result list on sheet2 could be sorted ascending order which would give an efficient way to go collect the items. For example if Sheet1, A1 were phillips screws and B1 was 461, can you click only A1 and copy A and B at the same time? Thanks for all of your help.
 


Code:
sub CopyValue()
  Sheets("Sheet2").[A1].end(xldown).offset(1).value = Activecell.value
end sub

Skip,
[sup][glasses]Don't let the Diatribe...
talk you to death![tongue][/sup][sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 



This works...SIMPLE!
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  Plan2.[A1].End(xlDown).Offset(1).Value = Target.Value

end sub


Skip,
[sup][glasses]Don't let the Diatribe...
talk you to death![tongue][/sup][sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 


Actually I noticed that you might just have the HEADING value on Plan2, so it's a tad more complex...
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With Plan2.[A1]
        If .CurrentRegion.Rows.Count = 1 Then
            .Offset(1).Value = Target.Value
        Else
            .End(xlDown).Offset(1).Value = Target.Value
        End If
    End With
end sub


Skip,
[sup][glasses]Don't let the Diatribe...
talk you to death![tongue][/sup][sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
That's exactly right!! Is there any way to make it copy the contents of the cell next to it in B column as well?

Thank you very much
Dave
 



BTW, it's not COPYING anything. It is assigning the value in one cell to another cell.
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    dim lRow as long, iCol as integer
    With Plan2.[A1]
        If .CurrentRegion.Rows.Count = 1 Then
            lRow = .Offset(1).row
        Else
            lRow = .End(xlDown).Offset(1).row
        End If
        for icol = 1 to 2
           .cells(lRow, iCol).value = target.offset(0, iCol-1).value
        next
    End With
end sub



Skip,
[sup][glasses]Don't let the Diatribe...
talk you to death![tongue][/sup][sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Yes that works. It follows my idea, the difference is that I create variables to make changes flexible. If one do not need parameters just cut them off.

Carlos César tanaka
Curso de Excel / Access
MPR Informática
 



Is that a question?

Skip,
[sup][glasses]Don't let the Diatribe...
talk you to death![tongue][/sup][sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top