표 내용을 띄엄띄엄 복사

이번 내용은 https://cafe.naver.com/excelmaster/158961 에 올라온 질문입니다.

1번과 같은 표가 있고

2번의 양식으로 출력하고자 하는 질문입니다.

옛날 부산소방학교에서 근무할 때 교육생 명단을 가지고 명찰을 만들던 것과 같은 양상이군요.

(사실 VBA를 공부하게 된 계기도 교육생 명찰을 만들기 위함이었지요)

풀이 과정은 다음과 같습니다.

1번 표의 A열의 제목을 순환하여

2번 양식에 붙여넣습니다.(간단?)

주의할 점은

홀수 제목은 왼쪽에 짝수 제목은 오른쪽에 있으니

Column에 해당하는 변수를 왔다갔다만 잘 해주면 됩니다.

Option Explicit
 
Sub Macro()
 
    Dim r As Integer
    Dim c As Integer
    Dim SingleRange As Range
    Dim DataArea As Range
    
    'A열 순환
    Set DataArea = Range("A3", Cells(Rows.Count, 1).End(3))
    
    '붙여넣기 셀 지정
    r = 2
    c = 4
    
    '1번 표를 2번 표에 출력
    For Each SingleRange In DataArea
        
        '홀수 제목 출력
        With Cells(r, c)
            .Value = Range("A2")
            .Offset(1) = Range("B2")
            .Offset(, 1) = SingleRange
            .Offset(1, 1) = SingleRange.Offset(, 1)
        End With
        
        '짝수제목 출력
        c = c + 3
        
        '출력 셀 영역 재지정
        If c > 7 Then
            r = r + 3
            c = 4
        End If
            
    Next SingleRange
    
End Sub
 

셀복사 문의.xlsm