Simplifying code

[rutgerterhaar]

I'm have an excel sheet (sheet1) in which a user can enter characteristics about a "group of people". When all the necessary characteristics are filled in about a specific group of people the user has to push a button, so that all the characteristics will be copied to another sheet (sheet2). In sheet2 there is a row for every group of people in which all the characteristics from the group will be placed according to the group number.

When the user pushes a button this macro puts the data from sheet1 in sheet2 in a row according to the "groupnumber" (cell C53 in sheet2 is the groupnumber linked from sheet1):


'Copy the value from the characteristic in cell K10
Range("K10").Select
Selection.Copy

'Search in sheet2 for the row with the right group number in Range("D52:D62") and select the groupnumber cell
Sheets("Sheet2").Select
Range("D52:D62").Select
Cells.Find(What:=Range("C53"), After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Activate
ActiveCell.Select

'Depending on the characteristic the copied value will be placed in a specific cell in the row
Selection.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("sheet1").Select

Since a group of people has 20 characteristic this code has to be copied 20 times with a different cell to copy and a different offset. In a later stadium I have to get all the data from sheet2 back in sheet1, so I will you this principle many times.

Is there an easier way to do this?

I hope it is clear what I mean and sorry for my crapy english .

Thanks!!!!

Rutger

 

[AlphaFrog]

Hi and welcome to the board.

    [color=darkblue]Dim[/color] wsSource [color=darkblue]As[/color] Worksheet, wsDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] rngFoundGroup [color=darkblue]As[/color] Range
    
    [color=darkblue]Set[/color] wsSource = Sheets("Sheet1")
    [color=darkblue]Set[/color] wsDest = Sheets("Sheet2")
    
    [color=green]'Search in sheet2 for the row with the right group number in Range("D52:D62")[/color]
    [color=darkblue]Set[/color] rngFoundGroup = wsDest.Range("D52:D62").Find(What:=wsDest.Range("C53"), _
                                                     LookIn:=xlValues, _
                                                     LookAt:=xlWhole, _
                                                     SearchOrder:=xlByColumns, _
                                                     SearchDirection:=xlNext)
    
    [color=darkblue]If[/color] rngFoundGroup [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        MsgBox "Cannot find group: " & wsDest.Range("C53").Value, , "No Group Match"
        [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]Else[/color]
        [color=green]'Copy the value from the characteristic in cell K10[/color]
        [color=green]'Depending on the characteristic the copied value will be placed in a specific cell in the row[/color]
        rngFoundGroup.Offset(, 1).Value = wsSource.Range("K10").Value
        [color=green]'Copy other values[/color]
        [color=green]'***Made up code for Example purposes***[/color]
        rngFoundGroup.Offset(, 2).Value = wsSource.Range("M10").Value
        rngFoundGroup.Offset(, 3).Resize(, 3).Value = wsSource.Range("O10:Q10").Value
        rngFoundGroup.Offset(, 6).Value = wsSource.Range("Z10").Value
    [color=darkblue]End[/color] [color=darkblue]If[/color]

 

[rutgerterhaar]

Hi Alphafrog!

This code is working perfect!!! Thanks for your help!!

Rutger.