copy sheet by reference number

HI,

See if this is close to what you want.

Hi,

First off the code does start copying to the "serch data" sheet starting at row 2. However if there is info somewhere else in column "A" then the code will copy to the cell below that info. So you must make sure column "A" is clear except for where the data is to be placed.

Next the code loops thru all work sheets and if it sees the values you entered on the "serch" sheet it will copy the info that I set for the copy and paste.

Now the code can be modified to copy the range you want to row5 of the serch sheet, but it would be easier if the info to be copied were formated to be in the columns that need to be copied. IE: c,d,e,f.

Hi,charles
1.sorry ,for my wrong first question. i want to begin at row 5. so i edit your code at lrow = Sheets("all serch data").Range("A65536").End(xlUp).Row + 4 that'is ok but have the blank row .for eg.row33-35 ,that i do not need it.
2.the second question ,my workbook have more than sheet 1,2,3,4... but it have another sheets name which i do not copy . i want to copy it from sheet1,2,3,4... to the "serch sheet". begin at row 5 .and copy only some column as the example.
let me show you the eg. i do not understand how to edit the code for using with the first and second of my question.
i hope you or any one help me this . by give me the eg.to see
appreciate thank.

Hi,

The following code should eliminate the blank rows.
I or someone will get back to you with the copy range.

Sub XferData()
Application.ScreenUpdating = False
Dim lrow As Long, lc As Long, lr As Long
Dim myval As String
Dim i As Integer
Dim ws As Worksheet
For i = 1 To Sheets("all  serch data").Cells(Rows.Count, 14).End(xlUp)
    myval = Cells(i, 14).Text
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "all  serch data" Then
            If ws.Range("A1").Text = myval Then
                lrow = Sheets("all  serch data").Range("A65536").End(xlUp).Row + 4
                If lrow > 4 Then
                    lrow = Sheets("all  serch data").Range("A65536").End(xlUp).Row + 1
                End If
                Sheets(ws.Name).Activate
                lr = Sheets(ws.Name).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                lc = Sheets(ws.Name).Range("IV3").End(xlToLeft).Offset(0, 1).Column
                Sheets(ws.Name).Range(Cells(3, 1), Cells(lr, lc)).Copy Destination:=Sheets("all  serch data").Range("A" & lrow)
                Sheets("all  serch data").Activate
                Exit For
            End If
        End If
    Next ws
Next i
Application.ScreenUpdating = True
End Sub