copy ข้อมูลข้ามไฟล์จากแนวตั้งเป็นแนวนอนโดยมีเงื่อนไข

[wongsaton]

ปัญหาของผมคือ ผมอยากจะให้ข้อมูลในไฟล์ปลายทางถูกจัดอยู่ในตารางในรูปแบบที่กำหนด พอจะมีวิธีไหนหรือ code ไหนไหมครับที่จะสามารถกำหนดที่อยู่ ที่จะให้ไฟล์ไปวางข้อมูลไว้ได้ครับ ผมลองทำยังไงก็เป็นแนวตั้งครับ รบกวนทุกท่านด้วยนะครับ ขอบคุณครับ
ปล.ผมแนบไฟล์ตัวอย่างมาแล้วครับ

[bank9597]

ลองโค๊ดนี้ดูครับ

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

เปลี่ยน strPath = "C:\Users\bank9597\Downloads\" เอาน่ะครับ

[wongsaton]

ขอบคุณ คุณ bank9597 มากครับ ผมจะลองนำ code ไปปรับใช้ดูครับ