auto copy specific data from one sheet to other

[priyank]

Hi

I just want to check that if it is possible to copy specific cells from one row to another sheet by using macro or any other script.

Attached is a sheet which explains what exectly I want

The sheet one is having Source data
Sheet three is the result sheet

If I put some code numbers (in number form) it should search the data from source sheet and update the same in result sheet in different rows

Please help

[PTG258]

Record what you can then tweak as need be.
Below is a recorded macro of what I think your'e asking

Sub Macro2() 
     
    Sheets("results").Select 
    Selection.EntireRow.Insert 
    Sheets("source").Select 
    Rows("2:2").Select 
    Selection.Copy 
    Sheets("results").Select 
    Range("A2").Select 
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ 
    False, Transpose:=False 
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ 
    False, Transpose:=False 
    Range("A2").Select 
End Sub 

[priyank]

No ... seems not working ...
1 Its just copying the entire first row only
2 I need some filtered data ... is it possible.
I am attaching the file after the results ...

[priyank]

can anyone help me out

[Krishnakumar]

Hi,

Try,

Sub test() 
    Dim sWs     As Worksheet 
    Dim rWs     As Worksheet 
    Dim Dest    As Range 
    Dim sData   As Range 
    Dim lRow    As Long 
    Dim CodeNo  As String 
     
    Set sWs = Sheets("source") 
    Set rWs = Sheets("results") 
    lRow = sWs.Cells(Rows.Count, 1).End(xlUp).Row 
    Set sData = sWs.Range("A1:V" & lRow) 
    Set Dest = rWs.[a1] 
     
    CodeNo = Application.InputBox("Enter the Code #", "Code Search") 
    If CodeNo = "" Then Exit Sub 
    CodeNo = Application.WorksheetFunction.Text(CodeNo, "00000000000") 
    If Application.WorksheetFunction.CountIf(sWs.Columns(1), CodeNo) > 0 Then 
        rWs.Cells.Clear 
        With sData 
            .AutoFilter field:=1, Criteria1:=CodeNo 
            .CurrentRegion.Copy Dest 
            .AutoFilter 
        End With 
    End If 
End Sub 

HTH

[priyank]

its working ... but almost same issue ..
its still writing only in the first row..

[Krishnakumar]

Sub test_v1() 
    Dim sWs     As Worksheet 
    Dim rWs     As Worksheet 
    Dim Dest    As Range 
    Dim sData   As Range 
    Dim lRow    As Long 
    Dim CodeNo  As String 
     
    Set sWs = Sheets("source") 
    Set rWs = Sheets("results") 
    lRow = sWs.Cells(Rows.Count, 1).End(xlUp).Row 
    Set sData = sWs.Range("A1:V" & lRow) 
    Set Dest = rWs.Cells(Rows.Count, 1).End(xlUp).Offset(1) 
     
    CodeNo = Application.InputBox("Enter the Code #", "Code Search") 
    If CodeNo = "" Then Exit Sub 
    CodeNo = Application.WorksheetFunction.Text(CodeNo, "00000000000") 
    If Application.WorksheetFunction.CountIf(sWs.Columns(1), CodeNo) > 0 Then 
         
        With sData 
            .AutoFilter field:=1, Criteria1:=CodeNo 
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy Dest 
            .AutoFilter 
        End With 
    End If 
End Sub 

[priyank]

Thanks
it seems working ...
Just one querry . ... can I only pickup few cells of a row in the result sheet ...

Currently its perfectly copying the entire row ... but if I want few specific colums... is it possible.

[Krishnakumar]

Yes, possible. Let's know which are the columns.

[priyank]

If you see in the attached sheet .... the colums from source sheet ... I need few colomns in Result sheet.

Source Sheet Result Sheet
Column A ---------> Column A
Column B ---------> Column B
Column E ---------> Column C
Column D ---------> Column D
Column F ---------> Column E

Thanks for your help..