셀값이 같은 행으로 정렬

기준표와

각 창고표가 있다.

기준표의 상품코드와 창고표의 상품코드를 비교해서

기준표의 상품코드에 맞게 순서를 재배치 하고

기준표에 없는 상품코드들은 기준표의 밖에 차례대로 재배치함.

이 모든 것들을 배열로 처리함.

Option Base 1
 
Sub Macro()
 
    Dim vL As Variant
    Dim varR As Variant
    Dim vR As Variant
    Dim var창고() As Variant
    Dim varAll() As Variant
    Dim i As Byte
    Dim j As Byte
    Dim k As Byte
    Dim v As Byte
    Dim c As Byte
    Dim btMatch As Byte
    Dim rng창고 As Range
    Dim rngArea As Range
 
    '원본 시트 보호 위해 시트 복사
    ActiveSheet.Copy
 
    '기준 상품코드 배열선언
    vL = WorksheetFunction.Transpose(Columns(1).SpecialCells(2, 1))
 
    '새 시트에 입력할 배열 varAll 선언 후 기준영역은 varAll에 미리 삽입
    Set rngArea = ActiveSheet.UsedRange.SpecialCells(2)
    ReDim varAll(rngArea.Areas.Count)
    With Range("A1").CurrentRegion
        varL = .Offset(2).Resize(.Rows.Count - 2)
    End With
    varAll(1) = varL
 
    '창고 영역을 순환
    For i = 2 To rngArea.Areas.Count
        Set rng창고 = rngArea.Areas(i)
 
        '창고 배열 선언
        With rng창고
            varR = Range(Cells(3, .Column), Cells(.Rows.Count, .Column + 3))
            ReDim var창고(unionRng(Columns(1).SpecialCells(2, 1), Columns(.Column).SpecialCells(2, 1)), 4)
        End With
 
        '창고의 상품코드와 기준코드를 비교해서 기준의 순서에 맞게 창고 상품코드를 재배열
        For j = 1 To UBound(varR)
 
            On Error Resume Next
                btMatch = WorksheetFunction.Match(varR(j, 1), vL, False)    '창고 코드와 기준코드를 비교해서 기존코드의 순서를 가져옴
 
                '창고코드가 기준코드에 존재하는지 체크
                Select Case Err.Number
                    Case 0
                        v = btMatch '있으면 기준코드의 순서에 맞춰서
                    Case Else
                        k = k + 1
                        v = UBound(vL) + k  '없으면 기준코드의 밖에
                End Select
            On Error GoTo 0
 
            '창고 배열을 기준코드에 맞게 재배열
            For c = 1 To 4
                var창고(v, c) = varR(j, c)
            Next c
        Next j
 
        '변수 초기화 및 새 시트에 입력할 배열에 재배열한 데이터 입력
        varAll(i) = var창고
        k = 0
        Erase var창고
    Next i
 
    '기존 내용 삭제 후 재배열한 데이터를 입력
    ActiveSheet.UsedRange.Offset(2).ClearContents
    Set rngArea = ActiveSheet.UsedRange.SpecialCells(2)
 
    For i = 1 To rngArea.Areas.Count
        Set rng창고 = rngArea.Areas(i)
        rng창고.Offset(2).Resize(UBound(varAll(i)), 4) = varAll(i)
    Next i
 
    '새로 복사한 시트에 있는 모든 버튼 삭제
    On Error Resume Next
        ActiveSheet.DrawingObjects.Delete
    On Error GoTo 0
 
End Sub
 
Function unionRng(rnG1 As Range, rnG2 As Range) As Integer  '창고 배열을 Redim 하기 위해 데이터 개수 파악
 
    Dim X As New Collection
    Dim rnG As Range
 
    On Error Resume Next
        For Each rnG In Union(rnG1, rnG2)
            X.Add rnG, CStr(rnG)
        Next rnG
    On Error GoTo 0
 
    unionRng = X.Count
End Function

복사본 EX.xls