Sammenskrivning af to macroer

Hejsa

Er der en ørn som kan sammenskrive disse to macroer til en:

1)
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Descrip As String
Dim thisrow As String
Dim r As Double
Dim c As Double

c = Selection.Columns.Count
r = Selection.Rows.Count
thisrow = Target.row

If c > 1 Or r > 1 Or Target.column <> 10 Or Target.Cells.Count <> 1 Then
    Exit Sub
End If

If IsError(Application.VLookup(Range("J" & thisrow).Value, Worksheets("Projects").Range("$B$3:$G$2000"), 6, False)) And Target.column = 10 Then
Range("K" & thisrow).Value = ""
Exit Sub
End If

If Target.Cells.Count = 1 Then
        Descrip = Application.VLookup(Range("J" & thisrow).Value, Worksheets("Projects").Range("$B$3:$G$2000"), 6, False)
        Range("K" & thisrow).Value = Descrip
End If
 
End Sub

-----------------------------------------------------------------
2)
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Competences As String
Dim thisrow As String
Dim r As Double
Dim c As Double

c = Selection.Columns.Count
r = Selection.Rows.Count
thisrow = Target.row

If c > 1 Or r > 1 Or Target.column <> 6 Or Target.Cells.Count <> 1 Then
    Exit Sub
End If

If IsError(Application.VLookup(Range("G" & thisrow).Value, Worksheets("Resource Pool").Range("$B$3:$C$2000"), 2, False)) And Target.column = 3 Then
Range("H" & thisrow).Value = ""
Exit Sub
End If

If Target.Cells.Count = 1 Then
        Descrip = Application.VLookup(Range("G" & thisrow).Value, Worksheets("Projects").Range("$B$3:$C$2000"), 2, False)
        Range("H" & thisrow).Value = Competences
End If
 
End Sub
--------------------------------------------------

På forhånd tak

Mvh
Claus