Copy and Paste adjacent cells

[sjfir]

Hi, I have a workbook that has 2 sheets on sheet 1 there are 3columns as below:<o></o>

A<o></o>	B<o></o>	C<o></o>
0<o></o>	0<o></o>	0<o></o>
1<o></o>	1.5<o></o>	AA<o></o>
1<o></o>	1.7<o></o> <o></o>	BB<o></o>
1<o></o>	1.6<o></o>	EE<o></o>
1<o></o>	0.4<o></o>	DD<o></o>
0<o></o>	0<o></o>	0<o></o>

<TBODY>
</TBODY>

On Sheet 2 there are two columns that I want to copy all the cells in Columns B&C from Sheet ! that have a 1 in column A. <o></o>
I have tried Vlookup and Index/Match without success. The idea is that once the data is copied I can then sort into order by column B.<o></o>
<o></o>
Sheet 2 would look like this before sorting.<o></o>

A<o></o>	B<o></o>
1.5<o></o>	AA<o></o>
1.7<o></o>	BB<o></o>
1.6<o></o>	EE<o></o>
0.4<o></o>	DD<o></o>

<TBODY>
</TBODY>

<o></o>
Just to add there approx. 850 rows in sheet 1 of which only about 25-50 will have the 1, this will change daily depending on calculations from another workbook. Any help greatly appreciated.<o></o>

 

[mumps]

This macro may do what you want:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Sheet2").UsedRange.ClearContents
    ActiveSheet.Range("$A$1:$C$" & LastRow).AutoFilter Field:=1, Criteria1:="1"
    ActiveSheet.Range("B2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet2").Cells(1, 1)
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    Application.ScreenUpdating = True
End Sub

 

[sjfir]

Thanks, it worked the only issue is that in those cells are formulae and I need to copy the value and not the formulae, the copied cells all say ref!

 

[mumps]

Maybe:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Sheet2").UsedRange.ClearContents
    ActiveSheet.Range("$A$1:$C$" & LastRow).AutoFilter Field:=1, Criteria1:="1"
    ActiveSheet.Range("B2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Sheet2").Cells(1, 1).PasteSpecial xlPasteValues
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[sjfir]

Thanks, that worked great.

 

[mumps]

My pleasure.