Snasui Excel Forum

Code: Select all

Option Explicit

Sub Button2_¤ÅÔ¡()

    Dim wbMain As Workbook
    Dim TargetWb As Workbook
    Dim strRange As Variant
    Dim strPath As String
    Dim strFileName As String
    Dim strName As Variant
    Dim rSource As Range
    Dim tSource As Range
    Dim i As Integer
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Set wbMain = ThisWorkbook
    strPath = "C:\Users\bank9597\Downloads\"
    strRange = Array("G14", "K14", "O14")
    
    For Each strName In strRange
        strFileName = wbMain.Sheets(1).Range(strName)
        Workbooks.Open(strPath & strFileName).Activate
        
        For i = 1 To 3
            Set rSource = wbMain.Sheets(1).Range(strName).Offset(9, i - 2).Resize(6, 1)
            Set TargetWb = Workbooks(strFileName)
            rSource.Copy
            TargetWb.Sheets(1).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Next i
        
    Next strName
    Application.ScreenUpdating = True
    MsgBox ("ºÑ¹·Ö¡¢éÍÁÙÅáÅéÇ")
    
    Set wbMain = Nothing
    Set TargetWb = Nothing
    Set rSource = Nothing
    
End Sub