vba:: _보이는 셀만 복사_ code 비교하기

 

보이는 셀만 복사해서 사용할 경우가 많은데, 인터넷에 찾아보면 종류가 많다.

막상 어떤 차이가 있는지 생각하지 않고서 써왔는데 어떤 코드는 길고 어떤 코드는 짧기에 무슨 차이가 있는지 한번 살펴보고자 한다.

 

 

 

 

 

 

 

---

 

 

 

Copy visible cells only in 365? - Microsoft Community Hub

Copy visible cells only in 365?

Sub CopyVisibleToVisible1()
'use this for:
'Copy paste(value only):
'from filtered range to filtered range
'from filtered range to unfiltered range
'from unfiltered range to filtered range
'Not work on hidden column

'How it works:
'Run the code > an inputbox will pop up > select the range to copy > OK > anoher inputbox will pop up
' > select the range to paste (select the first cell only) > OK
    
'If you need to use it frequently, you can put the code in a code module in the "Personal.xlsb" and
'then assign it to a button in the toolbar menu. So you just have to click the button when you need to run it.
    
    Dim rngA As Range
    Dim rngB As Range
    Dim r As Range
    Dim Title As String
    Dim ra As Long
    Dim rc As Long
    
    On Error GoTo skip:
    
    Title = "Copy Visible To Visible"
    Set rngA = Application.Selection
    Set rngA = Application.InputBox("Select Range to Copy then click OK:", Title, rngA.Address, Type:=8)
    
    Set rngB = Application.InputBox("Select Range to Paste (select the first cell only):", Title, Type:=8)
    Set rngB = rngB.Cells(1, 1)
    Application.ScreenUpdating = False

    ra = rngA.Rows.Count
    rc = rngA.Columns.Count
    If ra = 1 Then rngB.Resize(, rc).Value = rngA.Value: Exit Sub
    
    
    Set rngA = rngA.Cells(1, 1).Resize(ra, 1)
    
    For Each r In rngA.SpecialCells(xlCellTypeVisible)
      rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
        Do
          Set rngB = rngB.Offset(1, 0)
        Loop Until rngB.EntireRow.Hidden = False
    Next
    
    Application.GoTo rngB
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    

Exit Sub
skip:
    If err.Number <> 424 Then
        MsgBox "Error found: " & err.Description
    End If
    
    Application.ScreenUpdating = True
    Application.CutCopyMode = False

End Sub

 

 

---

 

https://m.blog.naver.com/rosa0189/60133151572

(67) 숨겨진 셀은 놔두고 보이는 셀만 복사 (엑셀 VBA 매크로)

Option Explicit
Sub copy_Visible_Range_Only()
   
    Dim rngSel As Range, rngT As Range
   
    On Error Resume Next                           '에러 발생해도 다음코드 진행
    Set rngSel = Selection.SpecialCells(xlCellTypeVisible)   '선택셀중 보이는 셀만 변수에
    Set rngT = Application.InputBox("복사하려는 위치(한 셀만)를 선택", "복사영역", Type:=8)
    If rngT Is Nothing Then Exit Sub              '취소 선택 시 중단
   
    If rngT.Rows.Count > 1 Or rngT.Columns.Count > 1 Then   '한 셀만선택하도록 설정
        MsgBox "복사위치는 한 셀만 선택하셔야 합니다.", 64, "영역선택 오류"
        Exit Sub
    End If

    With Application
        .CutCopyMode = False                      '클립보드 초기화 - 영역 잘못 선택 시 에러방지용 코드
        If Selection.Rows.Count = .Rows.Count Or _           

           Selection.Columns.Count = .Columns.Count Then   '영역 잘못 선택 시 에러 방지용 코드
            MsgBox "행이나 열 전체를 선택하면 오류. 영역 일부만 재선택후 실행"
            Exit Sub
        End If
    End With
   
    rngSel.Copy rngT   '선택영역을 복사영역에 복사.   이동은 숨겨진 행때문에 더 많은 코드 필요.
    
    On Error GoTo 0                                   '에러의 초기화
    Set rngSel = Nothing                             '개체변수 초기화
    Set rngT = Nothing                                '개체변수 초기화

End Sub

 

 

---

 

 

https://jujun.tistory.com/580

엑셀 VBA - 보이는 셀만 복사해서 붙여넣기 매크로 예제

Sub 보이는_셀만_복사()
'
' 보이는 셀만 복사하는 VBA 예제
'
 
'   Range로 복사할 범위를 지정하고 Copy로 복사
    Range("A1:C10").SpecialCells(xlCellTypeVisible).Copy
    
'  붙여넣기 할 시트를 선택
    Sheets("PasteSheet").Select
    
'  붙여넣기 구문 
    Range("A1").Select
    mitRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & mitRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    
    MsgBox "보이는 셀만 복사/붙여넣기 완료"
 
End Sub

 

 

 

---

 

https://thank-q.tistory.com/195

[땡큐엑셀vba & 엑셀매크로] 필터적용후 보이는셀만 복사

 

source by 땡큐엑셀vba & 엑셀매크로
'
Sub 보이는셀만복사()
    
    '출력행의 시작
    i = 7
    k = 0
    iDay = Range("A1") '선택열
    'iDay = Range("A1") '날짜
    'iStart = 13 '13은 M열.. 1:A, 2:B ....
    
    마지막행 = Range("C" & Rows.Count).End(xlUp).Row
    For Each rngC In Range("C4:C" & 마지막행)       'C4셀부터 마지막셀까지 순환
    
        If Rows(rngC.Row).Hidden = True Then        '만약 행이 숨겨져 있다면
            'Skip
        Else
            '31시트의 8행부터 시작
            i = i + 1
            
            'No번호
            k = k + 1
            Sheets("31").Cells(i, "A") = k
            Sheets("31").Cells(i, "D") = rngC
            Sheets("31").Cells(i, "E") = rngC.Offset(0, 1)
            'Sheets("31").Cells(i, "F") = Cells(rngC.Row, iStart + iDay)
            Sheets("31").Cells(i, "F") = Cells(rngC.Row, iDay)
        End If
     Next rngC


     MsgBox "완료되었습니다", vbInformation, "땡큐엑셀vba & 엑셀매크로"

End Sub

 

 

 

 

 

 

 

 

=end