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 John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel Macro to copy collumns

Status
Not open for further replies.

JohnOB

Technical User
Oct 5, 2006
253
GB
I have an excel spreadsheet with text at the top of each column, which I want to link to a macro which when clicked will copy the contents of the column before it.

The only macro I know how to do that does this is below

Code:
Sub TestCopyCollum()
'
' TestCopyCollum Macro
' Macro recorded 08/12/2006 by John O'Boyle
'

'
    Columns("B:B").Select
    Selection.Copy
    Columns("C:C").Select
    ActiveSheet.Paste
End Sub

However doing it this way would mean I would need one macro for each of my columns (and there are a lot) and I would need to go in and change each letters accordingly. Is there away I can change the macro so it knows what columns to copy and paste from regardless of which Column the macro is running from? So I would want to copy from the column before the one where I am clicking the text, to this one.

Any help is appreciated

Thanks

John


"The only stupid question is the one that doesn't get asked
 
So I would want to copy from the column before the one where I am clicking the text, to this one
something like this ?
Columns(ActiveCell.Column - 1).Copy ActiveCell

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColumn As Integer
Dim iRow As Long
Dim vTemp
Dim sAddress As String

Application.EnableEvents = False

sAddress = Target.Address
iColumn = Target.Column
iRow = Range(sAddress).End(xlDown)

If iRow > 0 Then 'Will be 0 if there is no data in column
   If Target.Count = 1 Then 'Stops copying if more then one cell is selected
      If Target.Row = 1 Then ' Only copies if first row is selected
         sAddress = sAddress & ":" & Left(sAddress, 2) & iRow
         vTemp = Range(sAddress)
         Range(sAddress).Offset(0, 1) = vTemp
      End If
   End If
End If
Application.EnableEvents = True
End Sub

The statement "iRow = Range(sAddress).End(xlDown)" will find the first empty cell in the column. If you have empty cells in the data just replace it with a value that will ensure all the data is copied.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top