Snasui Excel Forum

Code: Select all

Sub P11_Click()
Dim directory As String, fileName As String
    Dim sheet As Worksheet, j As Integer
    Dim tempBook As Workbook, thsBook As Workbook
    Application.ScreenUpdating = False
    'directory = "D:\ปพ.5\ปีการศึกษา2557\ประถม\เทอม1-2\ป.1-1\"
    directory = Sheets("ป.1").Range("c1").Value
    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
    j = 5 'บรรทัดที่ 5 คอลัมภ์ที่ 1 ชื่อไฟล์ที่นำไปแสดง
    Do While fileName <> ""
        Set tempBook = Workbooks.Open(directory & fileName)
        thsBook.Sheets("ป.1").Cells(j, 1) = tempBook.Name
        thsBook.Worksheets("ป.1").Cells(j, 5).Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("k19").Value

      j = j + 1
        tempBook.Close False
        fileName = Dir()
    Loop
       
    Application.ScreenUpdating = True
    'MsgBox ("รับข้อมูล...จาก Directory " & Sheets("ปก").Range("c1").Value & " เรียบร้อยแล้วครับ")
End Sub

Code: Select all

Do While fileName <> ""
    Set tempBook = Workbooks.Open(directory & fileName)
    With thsBook.Sheets("».1")
        .Cells(j, "a") = tempBook.Name
        .Cells(j, "d").Resize(1, 12).Value = _
            tempBook.Sheets("»¡").Range("f14:q14").Value
        .Cells(j, "q").Resize(1, 8).Value = _
            tempBook.Sheets("»¡").Range("c19:j19").Value
        .Cells(j, "z").Resize(1, 8).Value = _
            tempBook.Sheets("»¡").Range("l19:s19").Value
    End With
    j = j + 1
    tempBook.Close False
    fileName = Dir()
Loop

Code: Select all

Sub P11_Click()
Dim directory As String, fileName As String
    Dim sheet As Worksheet, j As Integer
    Dim tempBook As Workbook, thsBook As Workbook
    Application.ScreenUpdating = False
    'directory = "D:\ปพ.5\ปีการศึกษา2557\ประถม\เทอม1-2\ป.1-1\"
    directory = Sheets("ป.1-1").Range("c1").Value
    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
    j = 5 'บรรทัดที่ 5 คอลัมภ์ที่ 1 ชื่อไฟล์ที่นำไปแสดง
    
    Do While fileName <> ""
    Set tempBook = Workbooks.Open(directory & fileName)
    With thsBook.Sheets("ป.1-1")
        .Cells(j, "a") = tempBook.Name
        .Cells(j, "d").Resize(1, 12).Value = _
            tempBook.Sheets("ปก").Range("f14:o14").Value
        .Cells(j, "o").Resize(1, 4).Value = _
            tempBook.Sheets("ปก").Range("c19:f19").Value
        .Cells(j, "t").Resize(1, 4).Value = _
            tempBook.Sheets("ปก").Range("l19:o19").Value
    End With
    j = j + 1
    tempBook.Close False
    fileName = Dir()
Loop
       
    Application.ScreenUpdating = True
    'MsgBox ("รับข้อมูล...จาก Directory " & Sheets("ปก").Range("c1").Value & " เรียบร้อยแล้วครับ")
End Sub

Code: Select all

Do While fileName <> ""
    Set tempBook = Workbooks.Open(directory & fileName)
    With thsBook.Sheets("ป.1-1")
        .Cells(j, "a") = tempBook.Name
        .Cells(j, "d").Resize(1, 8).Value = _
            tempBook.Sheets("ปก").Range("f14:m14").Value
        .Cells(j, "l").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("n14:o14").Value
        .Cells(j, "m").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("p14:q14").Value
            
         .Cells(j, "o").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("c14:e14").Value
            
        .Cells(j, "q").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("c19:d19").Value
        .Cells(j, "r").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("e19:f19").Value
        .Cells(j, "s").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("g19:h19").Value
         .Cells(j, "t").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("i19:j19").Value
            
        .Cells(j, "v").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("l19:m19").Value
        .Cells(j, "w").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("n19:o19").Value
        .Cells(j, "x").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("p19:q19").Value
         .Cells(j, "y").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("r19:s19").Value
    End With
    j = j + 1
    tempBook.Close False
    fileName = Dir()
Loop

Code: Select all

Dim bookStr As String, rw As Integer

Code: Select all

Do While fileName <> ""
    Set tempBook = Workbooks.Open(directory & fileName)
    bookStr = VBA.Left(tempBook.Name, 6)
    On Error Resume Next
    With thsBook.Sheets("ป.1-1")
        rw = Application.Match(bookStr, .Range("b5:b10000"), 0) - 1
        If Err <> 0 Then
            MsgBox "File " & tempBook.Name & " not found in column B."
            Err = 0
        Else
            .Cells(j + rw, "a") = tempBook.Name
            .Cells(j + rw, "d").Resize(1, 8).Value = _
                tempBook.Sheets("ปก").Range("f14:m14").Value
            .Cells(j + rw, "l").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("n14:o14").Value
            .Cells(j + rw, "m").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("p14:q14").Value
            
            .Cells(j + rw, "o").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("c14:e14").Value
            
            .Cells(j + rw, "q").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("c19:d19").Value
            .Cells(j + rw, "r").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("e19:f19").Value
            .Cells(j + rw, "s").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("g19:h19").Value
            .Cells(j + rw, "t").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("i19:j19").Value
            
            .Cells(j + rw, "v").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("l19:m19").Value
            .Cells(j + rw, "w").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("n19:o19").Value
            .Cells(j + rw, "x").Resize(1, 1).Value = _
            tempBook.Sheets("ปก").Range("p19:q19").Value
            .Cells(j + rw, "y").Resize(1, 1).Value = _
                tempBook.Sheets("ปก").Range("r19:s19").Value
        End If
    End With
    'j = j + 1
    tempBook.Close False
    fileName = Dir()
Loop