Use PickUp to copy the adjustment and Apply to apply it!

[VBA]Dim adj() As Single

Sub pickUpAdj()
Dim oshp As Shape
Dim i As Integer
On Error GoTo err:
Set oshp = ActiveWindow.Selection.ShapeRange(1)
ReDim adj(1 To oshp.Adjustments.Count)
For i = 1 To oshp.Adjustments.Count
adj(i) = oshp.Adjustments(i)
Next i
Exit Sub
err:
MsgBox "ERROR"
End Sub

Sub applyAdj()
Dim oshp As Shape
Dim i As Integer
On Error GoTo err:
Set oshp = ActiveWindow.Selection.ShapeRange(1)
ReDim Preserve adj(1 To oshp.Adjustments.Count)
For i = 1 To oshp.Adjustments.Count
oshp.Adjustments(i) = adj(i)
Next i
Exit Sub
err:
MsgBox "ERROR"
End Sub
[/VBA]