복사 붙여넣기 후 삭제 해결방법

Sub Enter_Gathering1()


   Dim rng As Range, c As Range, rngA As Range
   Dim lR As Long, i As Long, cnt As Long
   Dim adrE As String, adrG As String
   Dim dT As Date
   
   dT = Sheet2.Range("b3").Value
   
   Application.ScreenUpdating = False
   
   Set rng = Sheet2.Range("a4").CurrentRegion
   Set rng = rng.Offset(2).Resize(rng.Rows.Count - 2, 1)
   
   lR = Sheet1.Cells(Rows.Count, "b").End(3).Row
   For Each c In rng
      With Sheet1
         i = i + 1
         .Activate
         .Cells(lR + i, "b") = Sheet2.Range("b3")
         .Cells(lR + i, "c") = "입고"
         .Cells(lR + i, "d") = c
         .Cells(lR + i, "e") = c.Offset(, 2)
         .Cells(lR + i, "f") = c.Offset(, 1)
         .Cells(lR + i, "g") = Round(c.Offset(, 1), 0)
         .Cells(lR + i, "h") = c.Offset(, 3)
          
      End With
   Next
   
   With Sheet1
            .Columns("b").NumberFormat = "yyyy-mm-dd"
            .Columns("e:h").NumberFormat = "#,###"
            .Columns("f").NumberFormat = "#,###.00000"
            
      '식별코드 수식입력
      cnt = .Columns("b").SpecialCells(2).Count + 2
      adrE = .Cells(Rows.Count, "a").End(3)(2).Offset(, 3).Address(0, 0)
      adrG = .Cells(Rows.Count, "a").End(3)(2).Offset(, 5).Address(0, 0)
      Range(.Cells(Rows.Count, "a").End(3)(2), .Cells(cnt, "a")) = "=" & adrE & "&""_""&" & adrG
      
      Call Enter_Ledger(lR, rng.Rows.Count)
      
      Set rngA = Sheet2.UsedRange
      Set rngA = rngA.Offset(4)
      Union(Sheet2.Range("b3"), rngA).ClearContents
      
      
      .Cells(lR + i, "h").Select
      .Range("a3").CurrentRegion.Sort .Range("b3"), xlAscending, Header:=xlYes
      .Range("a3").CurrentRegion.Borders.LineStyle = 1
   End With
      
     
   Application.ScreenUpdating = True

   MsgBox dT & " 입고증 등록 완료"
End Sub


   Application.ScreenUpdating = True
   

입고에 값을 입력한 뒤에 재고 내역에 값만 붙여넣기 후 표시한 부분만 삭제하는 식인데요..

제가 찾던 것을 이미 만드신 분이 계서서 보고 해보려고하는데 이해가 대부분이 안가서요...,

 

만약, 엑셀 파일을 만들어주시기 어려우시면 주석만 달아주시면 감사하겠습니다.

다른 곳에도 여러곳에 쓰려고 했는데 제게는 너무 어려운가봐요..