vba 엑셀 필터된 셀 값으로 붙여넣기

화면에 보이는 셀만 같은 행, 다른 열에 붙여넣기

https://www.youtube.com/watch?v=1E6lXr2Wtng&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=2

Sub PasteVisibleCells()
   Dim rngS As Range, rngT As Range, c As Range
   Dim i As Long
  
  
'   Sheet1.Columns("e:g").Delete
  
   on Error Resume Next
      Set rngS = Application.InputBox("복사할 범위를 드래그하세요", Type:=8)
      If rngS Is Nothing Then Exit Sub
     
      Set rngT = Application.InputBox("붙여넣을 범위를 드래그하세요", Type:=8)
      If rngT Is Nothing Then Exit Sub
   on Error GoTo 0
  
  
   i = 1
   For Each c In rngT.SpecialCells(xlCellTypeVisible)
compare:
      If rngT.Cells(i).RowHeight <> 0 Then
            c = rngS.Cells(i).Value
            i = i + 1
      Else
            i = i + 1
            GoTo compare
     
      End If
   Next

End Sub

========================================================

수정

타겟 첫 셀만 선택

Sub PasteVisibleCells()

    Dim rngS As Range, rngT As Range, c As Range

    Dim i As Long

    Dim firstcellT As Range

   

    on Error Resume Next

    Set rngS = Application.InputBox("복사할 범위를 드래그하세요", Type:=8)

    

    If rngS Is Nothing Then Exit Sub

    Set firstcellT = Application.InputBox("셀을 선택하십시오", Type:=8)

    firstcellT = ActiveCell

    If firstcellT Is Nothing Then Exit Sub

    on Error GoTo 0

    Set rngT = Range(firstcellT, firstcellT.Offset(rngS.Rows.Count - 1, rngS.Columns.Count - 1))

    i = 1

    For Each c In rngT.SpecialCells(xlCellTypeVisible)

compare:

    If rngT.Cells(i).RowHeight <> 0 Then

        c = rngS.Cells(i).Value

        i = i + 1

    Else

        i = i + 1

        GoTo compare

      

    End If

    Next

End Sub