Snasui Excel Forum

Code: Select all

With Workbooks("ME15812 SLIT.xlsx").Worksheets("ME15812 SLIT")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For Each rs In rall
        If Not o.Exists(rs.Value) Then
            k = Application.CountIf(rall, rs.Value)
            o.Add Item:=rs.Address(0, 0) & "|" & k, Key:=rs.Value
        End If
    Next rs
    a = o.keys
    
    For i = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F101")
        b = Split(o.Item(a(i)), "|")
        For j = 4 To 9
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, j).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next j

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F104")
        b = Split(o.Item(a(e)), "|")
        For f = 12 To 17
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, f).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next f

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F98")
        b = Split(o.Item(a(g)), "|")
        For h = 24 To 29
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, h).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next h

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F119")
        b = Split(o.Item(a(m)), "|")
        For n = 38 To 40
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, n).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next n

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F116")
        b = Split(o.Item(a(q)), "|")
        For c = 41 To 46
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, c).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next c

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F113")
        b = Split(o.Item(a(v)), "|")
        For w = 47 To 52
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, w).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next w
        Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F122:U124").Value = "OK"
    Next i
End With

Code: Select all

Sub Button1_Click()

Dim rall As Range
Dim rs As Range, rt As Range, r As Range
Dim i As Integer, j As Integer
Dim e As Integer, f As Integer
Dim g As Integer, h As Integer
Dim m As Integer, n As Integer
Dim q As Integer, c As Integer
Dim v As Integer, w As Integer
Dim o As Object, k As Integer
Dim a As Variant, b As Variant
Set o = CreateObject("Scripting.Dictionary")

With Workbooks("ME15812 SLIT.xlsx").Worksheets("ME15812 SLIT")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For Each rs In rall
        If Not o.Exists(rs.Value) Then
            k = Application.CountIf(rall, rs.Value)
            o.Add Item:=rs.Address(0, 0) & "|" & k, Key:=rs.Value
        End If
    Next rs
    a = o.keys
    
    For i = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F101")
        b = Split(o.Item(a(i)), "|")
        For j = 4 To 9
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, j).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next j
    Next i
    
    For e = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(e)).Range("F104")
        b = Split(o.Item(a(e)), "|")
        For f = 12 To 17
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, f).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next f
    Next e
      
    For g = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(g)).Range("F98")
        b = Split(o.Item(a(g)), "|")
        For h = 24 To 29
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, h).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next h
    Next g
    
    For m = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(m)).Range("F119")
        b = Split(o.Item(a(m)), "|")
        For n = 38 To 40
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, n).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next n
    Next m

    For q = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(q)).Range("F116")
        b = Split(o.Item(a(q)), "|")
        For c = 41 To 46
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, c).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next c
    Next q

    For v = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(v)).Range("F113")
        b = Split(o.Item(a(v)), "|")
        For w = 47 To 52
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, w).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next w
    Next v

End With

Set wbTaget = Workbooks("ME15812.xlsx")
        
    Set shTaget = wbTaget.Sheets("SL-41")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-42")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-46")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-48")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-50")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-37")
        shTaget.Range("F122:U124").Value = "OK"

End Sub

Code: Select all

Dim rall As Range
Dim rs As Range, rt As Range, r As Range
Dim i As Integer, j As Integer
Dim o As Object, k As Integer
Dim a As Variant, b As Variant
Set o = CreateObject("Scripting.Dictionary")

With Workbooks("ME15812 MOLD LOWER.xlsx").Worksheets("ME15812 MOLD LOWER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For Each rs In rall
        If Not o.Exists(rs.Value) Then
            k = Application.CountIf(rall, rs.Value)
            o.Add Item:=rs.Address(0, 0) & "|" & k, Key:=rs.Value
        End If
    Next rs
    a = o.keys
    For i = 0 To UBound(a)
        Set rt = Workbooks("ME 15812_01.xlsx").Worksheets(a(i)).Range("E98")
        b = Split(o.Item(a(i)), "|")
        For j = 4 To 7
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, j).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next j
    Next i
End With

Code: Select all

Sub Test0()
    Dim rall As Range, shStr As String
    Dim rs As Range, rt As Range
    Dim i As Integer, j As Integer
    
With Workbooks("ME15812 MOLD LOWER.xlsx").Worksheets("ME15812 MOLD LOWER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For Each rs In rall
        If rs.Value = "M.5A" Then
            shStr = rall(i).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E98")
            For j = 4 To 4
                rt.Resize(rs).Value = _
                rall(rs).Offset(0, j).Resize(rs).Value
            Set rt = rt.Offset(0, 1)
            Next j
        End If
    Next
    
End With

End Sub

Code: Select all

Sub Test0()
    Dim rall As Range, shStr As String
    Dim rs As Range, rt As Range
    Dim i As Integer, j As Integer
    Dim k As Integer, l As Integer
    Dim m As Integer, n As Integer
    Dim o As Integer, p As Integer
    Dim q As Integer, r As Integer
    Dim v As Integer, w As Integer
    
 With Workbooks("ME15812 MOLD LOWER.xlsx").Worksheets("ME15812 MOLD LOWER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For i = 1 To rall.Count Step 9
        shStr = rall(i).Value
        Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E98")
        For j = 4 To 4
                rt.Resize(9).Value = _
                rall(i).Offset(0, j).Resize(9).Value
            Set rt = rt.Offset(0, 1)
        Next j
    Next i
    
    For k = 1 To rall.Count Step 9
            shStr = rall(k).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("H108")
            For l = 5 To 7
                rt.Resize(9).Value = _
                    rall(k).Offset(0, l).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next l
        Next k
        
    For m = 1 To rall.Count Step 9
            shStr = rall(m).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E117")
            For n = 10 To 15
                rt.Resize(9).Value = _
                    rall(m).Offset(0, n).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next n
        Next m
        
    For o = 1 To rall.Count Step 9
            shStr = rall(o).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E126")
            For p = 17 To 22
                rt.Resize(9).Value = _
                    rall(o).Offset(0, p).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next p
        Next o
  End With

With Workbooks("ME15812 MOLD UPPER.xlsx").Worksheets("ME15812 MOLD UPPER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For q = 1 To rall.Count Step 9
            shStr = rall(q).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E108")
            For r = 4 To 6
                rt.Resize(9).Value = _
                    rall(q).Offset(0, r).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next r
        Next q
        
    For v = 1 To rall.Count Step 9
            shStr = rall(v).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E162")
            For w = 7 To 9
                rt.Resize(9).Value = _
                    rall(v).Offset(0, w).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next w
        Next v
               
End With

End Sub

Code: Select all

Sub Test0()
    Dim rall As Range, shStr As String
    Dim rs As Range, rt As Range
    Dim i As Integer, j As Integer
    Dim k As Integer, l As Integer
    Dim m As Integer, n As Integer
    Dim o As Integer, p As Integer
    Dim q As Integer, r As Integer
    Dim v As Integer, w As Integer
    
 With Workbooks("ME15812 MOLD LOWER.xlsx").Worksheets("ME15812 MOLD LOWER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For i = 1 To rall.Count Step 9
        shStr = rall(i).Value
        Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E98")
        For j = 4 To 4
                rt.Resize(9).Value = _
                rall(i).Offset(0, j).Resize(9).Value
            Set rt = rt.Offset(0, 1)
        Next j
    Next i
    
    For k = 1 To rall.Count Step 9
            shStr = rall(k).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("H108")
            For l = 5 To 7
                rt.Resize(9).Value = _
                    rall(k).Offset(0, l).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next l
        Next k
        
    For m = 1 To rall.Count Step 9
            shStr = rall(m).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E117")
            For n = 10 To 15
                rt.Resize(9).Value = _
                    rall(m).Offset(0, n).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next n
        Next m
        
    For o = 1 To rall.Count Step 9
            shStr = rall(o).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E126")
            For p = 17 To 22
                rt.Resize(9).Value = _
                    rall(o).Offset(0, p).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next p
        Next o
  End With

With Workbooks("ME15812 MOLD UPPER.xlsx").Worksheets("ME15812 MOLD UPPER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For q = 1 To rall.Count Step 9
            shStr = rall(q).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E108")
            For r = 4 To 6
                rt.Resize(9).Value = _
                    rall(q).Offset(0, r).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next r
        Next q
        
    For v = 1 To rall.Count Step 9
            shStr = rall(v).Value
            Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E162")
            For w = 7 To 9
                rt.Resize(9).Value = _
                    rall(v).Offset(0, w).Resize(9).Value
                Set rt = rt.Offset(0, 1)
            Next w
        Next v
               
End With

End Sub

Code: Select all

          shStr = Replace(rall(i).Value, "M", " M")
          shStr = Replace(shStr, "-", "")
          

Code: Select all

'         shStr = Replace(rall(i).Value, "M", " M")
'         shStr = Replace(shStr, "-", "")

Code: Select all

Sub Test0()
    Dim rall As Range, shStr As String
    Dim rs As Range, rt As Range
    Dim i As Integer, j As Integer

 With Workbooks("ME15812 LOWER.xlsx").Worksheets("LOWER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For i = 1 To rall.Count Step 9
'         shStr = Replace(rall(i).Value, "M", " M")
'         shStr = Replace(shStr, "-", "")
        shStr = rall(i).Value
        Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E98")
        For j = 4 To 4
                rt.Resize(9).Value = _
                rall(i).Offset(0, j).Resize(9).Value
            Set rt = rt.Offset(0, 1)
        Next j
    Next i
  
 End With
 End Sub

Code: Select all

Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E98")

Code: Select all

'Other code
With Workbooks("ME15812 LOWER.xlsx").Worksheets("LOWER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For i = 1 To rall.Count Step 8
'            shStr = Replace(rall(i).Value, "M", " M")
'            shStr = Replace(shStr, "-", "")
        shStr = rall(i).Value
        Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E98")
        For j = 4 To 4
                rt.Resize(3).Value = _
                rall(i).Offset(0, j).Resize(3).Value
            Set rt = rt.Offset(0, 1)
        Next j
    Next i     
'Other code   

End With

With Workbooks("ME15812 UPPER.xlsx").Worksheets("UPPER")
'Other code

Code: Select all

Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E98")

Code: Select all

Sub Test0()
    Dim rall As Range, shStr As String
    Dim rs As Range, rt As Range
    Dim i As Integer, j As Integer
    Dim k As Integer, l As Integer
    Dim m As Integer, n As Integer
    Dim o As Integer, p As Integer
    Dim q As Integer, r As Integer
    Dim v As Integer, w As Integer
        
    With Workbooks("ME15812 LOWER.xlsx").Worksheets("LOWER")
        Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
        For i = 1 To rall.Count Step 8
            shStr = Replace(rall(i).Value, "M", " M")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E98")
            For j = 4 To 4
                            rt.Resize(3).Value = _
                    rall(i).Offset(0, j).Resize(3).Value
                Set rt = rt.Offset(0, 1)
            Next j
        Next i
         
        For k = 1 To rall.Count Step 8
            shStr = Replace(rall(k).Value, "M", " M")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("H108")
            For l = 5 To 7
                rt.Resize(3).Value = _
                    rall(k).Offset(0, l).Resize(3).Value
                Set rt = rt.Offset(0, 1)
            Next l
        Next k
        
        For m = 1 To rall.Count Step 8
            shStr = Replace(rall(m).Value, "M", " M")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E117")
            For n = 10 To 15
                rt.Resize(3).Value = _
                    rall(m).Offset(0, n).Resize(3).Value
                Set rt = rt.Offset(0, 1)
            Next n
        Next m
        
        For o = 1 To rall.Count Step 8
            shStr = Replace(rall(o).Value, "M", " M")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E126")
            For p = 17 To 22
                rt.Resize(3).Value = _
                    rall(o).Offset(0, p).Resize(3).Value
                Set rt = rt.Offset(0, 1)
            Next p
        Next o
        
        
        With Workbooks("ME15812 UPPER.xlsx").Worksheets("UPPER")
        For q = 1 To rall.Count Step 8
            shStr = Replace(rall(q).Value, "M", " M")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E108")
            For r = 4 To 6
                rt.Resize(3).Value = _
                    rall(q).Offset(0, r).Resize(3).Value
                Set rt = rt.Offset(0, 1)
            Next r
        Next q
        
            For v = 1 To rall.Count Step 8
            shStr = Replace(rall(v).Value, "M", " M")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book.xlsx").Worksheets(shStr).Range("E162")
            For w = 7 To 9
                rt.Resize(3).Value = _
                    rall(v).Offset(0, w).Resize(3).Value
                Set rt = rt.Offset(0, 1)
            Next w
        Next v
               
        End With

End Sub