selecting, copying and pasting from two non adjacent columns of data from a maxvalue in first column

[steve11]

Hi I am wanting to be able to find a max value in my first column (J and M) and from that index, copy the remaining row values in both that column and a non adjacent column, then paste these in the same sheet to 2 blank columns (say R and S) . Any ideas welcomed

Many thanks

Steve

 

[Truiz]

If I undertood you correctly this shouold work.

Sub Scapf2nacodfamifc()
Dim fRow As Long
Dim lRow As Long


lRow = Cells(Rows.Count, 10).End(xlUp).Row
fRow = WorksheetFunction.Index(Range("J:J"), WorksheetFunction.Match(WorksheetFunction.Max(Range("J:J")), Range("J:J"), 0)).Row


Range(Cells(fRow, 10), Cells(lRow, 10)).Copy Range(Cells(fRow, 24))
Range(Cells(fRow, 13), Cells(lRow, 13)).Copy Range(Cells(fRow, 25))


Application.CutCopyMode = False
End Sub

 

[Truiz]

I tested this one I use this one.

Sub Scapf2nacodfamifc()
Dim fRow As Long
Dim lRow As Long




lRow = Cells(Rows.Count, 10).End(xlUp).Row
fRow = WorksheetFunction.Index(Range("J:J"), WorksheetFunction.Match(WorksheetFunction.Max(Range("J:J")), Range("J:J"), 0)).Row




Range(Cells(fRow, 10), Cells(lRow, 10)).Copy Range(Cells(fRow, 19).Address)
Range(Cells(fRow, 13), Cells(lRow, 13)).Copy Range(Cells(fRow, 18).Address)




Application.CutCopyMode = False
End Sub

 

[steve11]

Many thanks for this Truiz, i don't think i explained very well. I want to look down column D for the max value, then take this row index and use it to copy and paste from columns J and M from this row index to the last values in columns J and M to the top of columns R and S.

Steve

 

[Truiz]

Ok so just need to adjust the columns a bit

Try this

[COLOR=#333333]Sub Scapf2nacodfamifc()
[/COLOR]Dim fRow As Long
Dim lRow As Long

lRow = Cells(Rows.Count, 10).End(xlUp).Row
fRow = WorksheetFunction.Index(Range("D:D"), WorksheetFunction.Match(WorksheetFunction.Max(Range("D:D")), Range("D:D"), 0)).Row

Range(Cells(fRow, 10), Cells(lRow, 10)).Copy Range(Cells(fRow, 19).Address)
Range(Cells(fRow, 13), Cells(lRow, 13)).Copy Range(Cells(fRow, 18).Address)




Application.CutCopyMode = False [COLOR=#333333]End Sub[/COLOR]

 

[steve11]

Ok so just need to adjust the columns a bit

Try this

[COLOR=#333333]Sub Scapf2nacodfamifc()
[/COLOR]Dim fRow As Long
Dim lRow As Long

lRow = Cells(Rows.Count, 10).End(xlUp).Row
fRow = WorksheetFunction.Index(Range("D:D"), WorksheetFunction.Match(WorksheetFunction.Max(Range("D:D")), Range("D:D"), 0)).Row

Range(Cells(fRow, 10), Cells(lRow, 10)).Copy Range(Cells(fRow, 19).Address)
Range(Cells(fRow, 13), Cells(lRow, 13)).Copy Range(Cells(fRow, 18).Address)




Application.CutCopyMode = False [COLOR=#333333]End Sub[/COLOR]

many thanks
Brill