Copy cell from one sheet to another-CodePudding

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.

CodePudding user response：

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.