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

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