간단하다.
두 시트의 내용을 한 시트로 합치는 내용으로 Find, Cut, Copy 로 금방 해결가능하다.
어떤 방식을 써볼까.. 고민하다가 그냥 무식하게 밀고 나감.
Option Explicit Sub getData() Dim wsAll As Worksheet, wsList As Worksheet, wsData As Worksheet Dim dataList As Range, dataTable As Range, rngPaste As Range Dim rngCell As Range, rngData As Range Dim intR As Integer Dim i As Integer With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With '워크시트, 상세항목 테이블 정의 Set wsAll = Sheets("절단내역") Set wsList = Sheets("발급대장") Set wsData = Sheets("상세항목") Set rngPaste = wsAll.Range("A5") Set dataList = Range(wsList.Range("A6"), wsList.Cells(Rows.Count, "A").End(xlUp)) Set dataTable = Range(wsData.Range("A4"), wsData.Cells(Rows.Count, "K").End(xlUp)) intR = dataTable.Rows.Count Set rngData = rngPaste.Resize(intR) '절단내역 시트 기존항목 삭제 Range(rngPaste, wsAll.Cells(Rows.Count, "S")).Clear '상세항목 데이터를 값만 가져와서 제목에 맞게 이동 dataTable.Copy rngPaste.PasteSpecial Paste:=xlPasteValues With rngPaste .Offset(, 2).Resize(intR, 2).Cut .Offset(, 12) .Offset(, 4).Resize(intR, 2).Cut .Offset(, 15) .Offset(, 6).Resize(intR, 2).Cut .Offset(, 17) .Offset(, 9).Resize(intR, 2).Cut .Offset(, 2) End With '발급대장에서 발급번호 일치하는 내용 가져오기 i = 1 For Each rngCell In rngData If rngCell = rngCell.Offset(1) Then i = i + 1 Else dataList.Find(what:=rngCell, lookat:=xlWhole).Offset(, 2).Resize(, 8).Copy rngCell.Offset(1 - i, 4).Resize(i) i = 1 End If Next rngCell '서식 지정 With rngData.Resize(, 19) .Font.Size = 10 .HorizontalAlignment = xlCenter .Columns(17).NumberFormatLocal = "yy""-""m""-""d;@" .Borders.LineStyle = xlNone End With rngPaste.Select With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub cs
'VB(A)' 카테고리의 다른 글
일정 기준으로 텍스트 나누기 (0) | 2015.03.13 |
---|---|
영어 한글 분리하기 (5) | 2015.03.13 |
이중유효성목록을 선택하여 차트생성하기 (0) | 2015.03.07 |
다른 셀로 하이퍼링크 설정 (0) | 2015.03.05 |
부부직원이면 빨간색으로 표시하기 (0) | 2015.03.01 |