엑셀 VBA 필터된 상태에서 보이는 셀의 원본 여러 행 범위 선택하면 대상 행에 복사 붙여넣기 / 원본 여러 열 범위 선택 대상 열 선택하면 같은 행에 복사

보이는 셀의 원본 여러 행 범위 선택하면 대상 행에 복사 붙여넣기

Sub 보이는셀복사붙여넣기()

    Dim rngSource As Range, rngTargetStart As Range
    Dim sourceVisibleRows As Range, targetVisibleCells As Range
    Dim sourceArray As Variant
    Dim i As Long, j As Long
    Dim targetRow As Range

    ' 사용자에게 복사할 소스 범위를 선택하도록 요청
    On Error Resume Next
    Set rngSource = Application.InputBox("복사할 범위를 선택하세요 (여러 행 포함).", Type:=8)
    If rngSource Is Nothing Then Exit Sub
    On Error GoTo 0

    ' 소스 범위에서 보이는 행만 가져오기
    On Error Resume Next
    Set sourceVisibleRows = rngSource.SpecialCells(xlCellTypeVisible)
    If sourceVisibleRows Is Nothing Then
        MsgBox "소스 범위에 보이는 행이 없습니다.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0

    ' 사용자에게 붙여넣기 시작 셀을 선택하도록 요청
    On Error Resume Next
    Set rngTargetStart = Application.InputBox("값을 붙여넣을 시작 셀을 선택하세요.", Type:=8)
    If rngTargetStart Is Nothing Then Exit Sub
    On Error GoTo 0

    ' 대상 시작 셀 기준으로 보이는 셀 가져오기
    On Error Resume Next
    Set targetVisibleCells = rngTargetStart.Parent.Range(rngTargetStart, rngTargetStart.Parent.Cells(Rows.Count, rngTargetStart.Column)).SpecialCells(xlCellTypeVisible)
    If targetVisibleCells Is Nothing Then
        MsgBox "대상 범위에 보이는 셀이 없습니다.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0

    ' 소스와 대상의 크기 검증
'    If sourceVisibleRows.Rows.Count > targetVisibleCells.Cells.Count Then
'        MsgBox "붙여넣기할 대상 행이 부족합니다.", vbExclamation
'        Exit Sub
'    End If

    ' 화면 업데이트 및 계산 비활성화
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' 보이는 소스 데이터를 배열로 저장
    Dim visibleSourceRows As Collection
    Set visibleSourceRows = New Collection

    For Each targetRow In sourceVisibleRows.Rows
        visibleSourceRows.Add targetRow
    Next targetRow

    ' 보이는 대상 셀과 소스를 매핑하여 데이터 복사
    i = 1
    For Each targetRow In targetVisibleCells
        ' 현재 소스 행 데이터를 배열로 가져오기
        sourceArray = visibleSourceRows(i).Value
        ' 배열 내용을 대상에 붙여넣기
        For j = 1 To UBound(sourceArray, 2)
            targetRow.Offset(0, j - 1).Value = sourceArray(1, j)
        Next j
        i = i + 1
        If i > visibleSourceRows.Count Then Exit For
    Next targetRow

    ' 화면 업데이트 및 계산 다시 활성화
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    ' 완료 메시지
    MsgBox "값 복사가 완료되었습니다.", vbInformation
End Sub

 

원본 여러 열 범위 선택 대상 열 선택하면 같은 행에 복사 붙여넣기

Sub 보이는셀복사붙여넣기_다른열에복사()
    Dim rngSource As Range, rngTargetStart As Range
    Dim sourceVisibleCells As Range
    Dim sourceCell As Range
    Dim targetCell As Range
    Dim sourceColumns As Long, colOffset As Long

    ' 소스 범위 선택 (여러 열 포함)
    On Error Resume Next
    Set rngSource = Application.InputBox("소스 열을 선택하세요 (필터된 상태에서, 여러 열 가능).", Type:=8)
    If rngSource Is Nothing Then Exit Sub
    On Error GoTo 0

    ' 소스 범위에서 보이는 셀 가져오기
    On Error Resume Next
    Set sourceVisibleCells = rngSource.SpecialCells(xlCellTypeVisible)
    If sourceVisibleCells Is Nothing Then
        MsgBox "소스 범위에 보이는 셀이 없습니다.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0

    ' 타겟 시작 열 선택
    On Error Resume Next
    Set rngTargetStart = Application.InputBox("타겟 시작 열을 선택하세요 (같은 행이어야 함).", Type:=8)
    If rngTargetStart Is Nothing Then Exit Sub
    On Error GoTo 0

    ' 소스 열 개수 계산
    sourceColumns = rngSource.columnS.Count

    ' 복사 시작
    Application.ScreenUpdating = False
    For Each sourceCell In sourceVisibleCells
        ' 타겟 열의 오프셋 계산
        colOffset = sourceCell.Column - rngSource.Column
        Set targetCell = rngTargetStart.Parent.Cells(sourceCell.Row, rngTargetStart.Column + colOffset)
        If Not targetCell.EntireRow.Hidden Then
            ' 데이터 복사
            targetCell.Value = sourceCell.Value
        End If
    Next sourceCell
    Application.ScreenUpdating = True

    ' 완료 메시지
    MsgBox "필터된 여러 열의 데이터가 복사되었습니다.", vbInformation
End Sub