davesexcel.com

Excel information

Most Popular Excel Questions

"How do I find data in a column, then copy and paste it to a new location?"

Posted by davesexcel on December 1, 2010 at 6:05 AM

This is one of the most popular excel quetions.


This example uses 2 ways to find data. A loop and a filter.




The first code loops through Column A and identifies the selection made from the ComboBox. When it finds an equal match it will copy and paste the item from Column A and B and paste it into the first empty row after the last used row in Column D.


'********************************************


Sub CopyAndPasteLoop()

'--------------------------------------------------------------

'Make a selection from the ComboBox

'Click the button of your choie of macro

 

    Dim R As Range, c As Range, Rng As Range

    Dim LstRw As Long, LstRws2 As Long

    Dim Str As String

 

    Str = Worksheets("Sheet1").ComboBox1

 

    LstRw = Cells(Rows.Count, "A").End(xlUp).Row

 

 

    Set R = Range(Cells(1, 1), Cells(LstRw, 1))

 

    ClearData

 

    For Each c In R.Cells

 

        LstRws2 = Cells(Rows.Count, "D").End(xlUp).Row + 1

        Set Rng = Cells(LstRws2, 4)

 

        If c = Str Then c.Range("A1:B1").Copy Destination:=Rng

 

    Next c

 

End Sub


'***************************************************

This next code the same thing, but pastes the results to Sheet2


'***********************************************************


Sub CopyAndPasteLoopToSheet2()

 

    Dim R As Range, c As Range, Rng As Range

    Dim LstRw As Long, LstRws2 As Long

    Dim Str As String, ws2 As Worksheet

 

    Set ws2 = Worksheets("Sheet2")

 

    Str = Worksheets("Sheet1").ComboBox1

 

    LstRw = Cells(Rows.Count, "A").End(xlUp).Row

 

 

    Set R = Range(Cells(1, 1), Cells(LstRw, 1))

 

    ClearData

    ClearDataSheet2

 

    For Each c In R.Cells

 

        LstRws2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

        Set Rng = ws2.Cells(LstRws2, 1)

 

        If c = Str Then c.Range("A1:B1").Copy Destination:=Rng

 

    Next c

 

    MsgBox "Finshed Copying to Sheet2"

 

End Sub

 

 


'******************************************************


The next code will use AutoFilter to filter out the item selected from the ComboBox and paste it to D2.


'*******************************************************

Sub FilterAndPaste()

 

    Dim Frng As Range, D2 As Range

    Dim Str As String

 

    Set D2 = Range("D2")

    Str = Worksheets("Sheet1").ComboBox1

 

    ClearData

 

    Range("A1").AutoFilter Field:=1, Criteria1:=Str

 

    With ActiveSheet.AutoFilter.Range

 

        Set Frng = .Offset(1, 0).Resize(.Rows.Count - 1, 2) _

                   .SpecialCells(xlCellTypeVisible)

 

    End With

 

    Frng.Copy Destination:=d2

 

    Range("A1").AutoFilter

 

End Sub

 

 


'******************************************************************


This uses the filter method and sends the filtered items to Sheet2

'*******************************************************************


Sub FilterAndPasteToSheet2()

 

    Dim Frng As Range, A2 As Range

    Dim Str As String, ws2 As Worksheet

 

    Set ws2 = Worksheets("Sheet2")

    Set A2 = ws2.Range("A2")

    Str = Worksheets("Sheet1").ComboBox1

 

    ClearData

    ClearDataSheet2

 

    Range("A1").AutoFilter Field:=1, Criteria1:=Str

 

    With ActiveSheet.AutoFilter.Range

 

        Set Frng = .Offset(1, 0).Resize(.Rows.Count - 1, 2) _

                   .SpecialCells(xlCellTypeVisible)

 

    End With

 

    Frng.Copy Destination:=A2

 

    Range("A1").AutoFilter

 

    MsgBox "Finshed Copying to Sheet2"

 

 

End Sub

 

 

 

"*****************************************************


You will need this code or you will get errors, all it does is clear the range before pasting new results.

'**********************************************

Sub ClearData()

 

    Dim Rws As Long, Rng As Range

 

 

    Rws = Cells(Rows.Count, "D").End(xlUp).Row

 

    Set Rng = Range(Cells(2, 4), Cells(Rws + 1, 5))

 

    Rng.Clear

 

 

End Sub

Sub ClearDataSheet2()

 

    Dim Rws As Long, Rng As Range, ws2 As Worksheet

 

    Set ws2 = Worksheets("Sheet2")

 

 

 

    Rws = ws2.Cells(Rows.Count, "A").End(xlUp).Row

 

    Set Rng = ws2.Range(ws2.Cells(2, 1), ws2.Cells(Rws, 2))

 

    Rng.Clear

 

 

End Sub

 

 

'******************************************************

 

 

Download the Sample Workbook




 The example also shows how to populate a combobox with unique items. Right click on the sheet tab, select view code.

 







Categories: Find Data and copy to new location

Post a Comment

Oops!

Oops, you forgot something.

Oops!

The words you entered did not match the given text. Please try again.

You must be a member to comment on this page. Sign In or Register

1 Comment

Reply Paul Morgan
9:42 AM on December 4, 2010 
I copied and pasted your code examples,(because I don't have xl'07 yet), and had my worksheet working in about 15 min. I used the filter example as the loop example would have taken forever, because of the 1000's of rows it would have to loop through.
Thanks man..