Snasui Excel Forum

Code: Select all

Sub Copy()
    Set wbSource = Workbooks("Book2.xlsx")
    Set shSource = wbSource.Sheets("Data")
    Set wbTaget = Workbooks("Book1.xlsx")
    Set shTaget1 = wbTaget.Sheets(" SL41")
    Set shTaget2 = wbTaget.Sheets(" SL42")
    Set shTaget3 = wbTaget.Sheets(" SL46")
    Set shTaget4 = wbTaget.Sheets(" SL37")
    '-----------------------------------------------------------------------------------
        shTaget1.Range("F98:F100").Value = shSource.Range("H2:H4").Value
        shTaget1.Range("H98:H100").Value = shSource.Range("I2:I4").Value
        shTaget1.Range("J98:J100").Value = shSource.Range("J2:J4").Value
        shTaget1.Range("L98:L100").Value = shSource.Range("K2:K4").Value
        shTaget1.Range("N98:N100").Value = shSource.Range("L2:L4").Value
        shTaget1.Range("P98:P100").Value = shSource.Range("M2:M4").Value
        
        shTaget2.Range("F98:F100").Value = shSource.Range("H5:H7").Value
        shTaget2.Range("H98:H100").Value = shSource.Range("I5:I7").Value
        shTaget2.Range("J98:J100").Value = shSource.Range("J5:J7").Value
        shTaget2.Range("L98:L100").Value = shSource.Range("K5:K7").Value
        shTaget2.Range("N98:N100").Value = shSource.Range("L5:L7").Value
        shTaget2.Range("P98:P100").Value = shSource.Range("M5:M7").Value
        
        shTaget3.Range("F98:F100").Value = shSource.Range("H8:H10").Value
        shTaget3.Range("H98:H100").Value = shSource.Range("I8:I10").Value
        shTaget3.Range("J98:J100").Value = shSource.Range("J8:J10").Value
        shTaget3.Range("L98:L100").Value = shSource.Range("K8:K10").Value
        shTaget3.Range("N98:N100").Value = shSource.Range("L8:L10").Value
        shTaget3.Range("P98:P100").Value = shSource.Range("M8:M10").Value
        
        shTaget4.Range("F98:F100").Value = shSource.Range("H11:H13").Value
        shTaget4.Range("H98:H100").Value = shSource.Range("I11:I13").Value
        shTaget4.Range("J98:J100").Value = shSource.Range("J11:J13").Value
        shTaget4.Range("L98:L100").Value = shSource.Range("K11:K13").Value
        shTaget4.Range("N98:N100").Value = shSource.Range("L11:L13").Value
        shTaget4.Range("P98:P100").Value = shSource.Range("M11:M13").Value
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
    With Workbooks("Book2.xlsx").Worksheets("Data")
        Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
        For i = 1 To rall.Count Step 3
            shStr = Replace(rall(i).Value, "A", " S")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book1.xlsx").Worksheets(shStr).Range("f98")
            For j = 4 To 8
                rt.Resize(3).Value = _
                    rall(i).Offset(0, j).Resize(3).Value
                Set rt = rt.Offset(0, 1)
            Next j
        Next i
    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("Book2.xlsx").Worksheets("Data")
        Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
        For i = 1 To rall.Count Step 3
            shStr = Replace(rall(i).Value, "A", " S")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book1.xlsx").Worksheets(shStr).Range("f101")
            For j = 4 To 9
                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 3
            shStr = Replace(rall(k).Value, "A", " S")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book1.xlsx").Worksheets(shStr).Range("f104")
            For l = 12 To 17
                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 3
            shStr = Replace(rall(m).Value, "A", " S")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book1.xlsx").Worksheets(shStr).Range("f98")
            For n = 24 To 29
                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 3
            shStr = Replace(rall(o).Value, "A", " S")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book1.xlsx").Worksheets(shStr).Range("f119")
            For p = 38 To 40
                rt.Resize(3).Value = _
                    rall(o).Offset(0, p).Resize(3).Value
                Set rt = rt.Offset(0, 1)
            Next p
        Next o
        
        For q = 1 To rall.Count Step 3
            shStr = Replace(rall(q).Value, "A", " S")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book1.xlsx").Worksheets(shStr).Range("f116")
            For r = 41 To 46
                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 3
            shStr = Replace(rall(v).Value, "A", " S")
            shStr = Replace(shStr, "-", "")
            Set rt = Workbooks("Book1.xlsx").Worksheets(shStr).Range("f113")
            For w = 47 To 52
                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

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

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")