Copy cell from one sheet to another - excel

Question

Sub Macro4()
'
' Macro4 Macro
'
' Keyboard Shortcut: Ctrl+Shift+D
'
Dim CellContent0
Dim CellContent1
Dim CellContent2
Dim CellContent3
CellContent0 = ActiveCell.Address
CellContent1 = ActiveCell.Offset(, -4)
CellContent2 = ActiveCell.Offset(, 1)
Sheets("1c").Select
Cells.Find(What:=CellContent1, After _
:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False). _
Activate
Cells.Find(What:=CellContent2, After _
:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False). _
Activate
ActiveCell.Offset(, -1).Copy
Sheets("shipping").Select
Range(CellContent0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Please advice how to fix the code.
I need to copy 2 cells to the left(-4) and right(1) from active cell. Then I go to another sheet and get value based on previous copied cells(-1).
Next I want to move back to previous sheet and paste copied value into initial active cell
For example If I run the macros from cell D7, finally I need to paste copied value to the same cell D7.

Answer 1

Since you do not answer my clarification question, please try the next adapted code which avoids selecting/activating, which only consume Excel resources, slowing the code speed and not bringing any benefit. It copies where your code tried to do it and the same value from clipboard is copied in the initially selected cell:
Sub Macro4()
' Macro4 Macro
' Keyboard Shortcut: Ctrl+Shift+D
Dim CellContent0 As Range, CellContent1 As Range, CellContent2 As Range
Dim ws1C As Worksheet, wsSh As Worksheet, Find1 As Range, Find2 As Range
Set ws1C = Sheets("1c")
Set wsSh = Sheets("shipping")
Set CellContent0 = ActiveCell
Set CellContent1 = CellContent0.Offset(, -4)
Set CellContent2 = CellContent0.Offset(, 1)
Set Find1 = ws1C.cells.Find(What:=CellContent1.value, After _
:=CellContent0, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set Find2 = ws1C.cells.Find(What:=CellContent2.value, After _
:=CellContent0, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not Find2 Is Nothing Then 'if a match has been found:
wsSh.Range(CellContent0.Address).value = Find2.Offset(, -1).value
'now I try copying what I understood from your comment:
CellContent0.value = Find2.Offset(, -1).value
End If
End Sub
Copying only the cell value, no clipboard is necessary, too.