Excel Forum

Code: Select all

Sub SendMarkMitterm2ToPP5_Click()
   Dim p, directory As String, fileName As String
    Dim sheet As Worksheet, j As Integer
    Dim tempBook As Workbook, thsBook As Workbook
    Dim bookStr As String, rw As Integer
    Application.ScreenUpdating = False
    p = Range("R1")
    directory = Sheets(p).Range("D1").Value

    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
    j = 7
    
Do While fileName <> ""
    Set tempBook = Workbooks.Open(directory & fileName)
    bookStr = VBA.Left(tempBook.Name, 6)
    On Error Resume Next
    With thsBook.Sheets(p)
        rw = Application.Match(bookStr, .Range("G2:AF2"), 0) - 1
        If Err <> 0 Then
            MsgBox "File " & tempBook.Name & " not found in Rows 5."
            Err = 0
        Else
        
            With tempBook.Sheets("คะแนน1")
                .Range("AJ7:AJ62").Value = _
                    thsBook.Worksheets("จปสคะแนนสอบกลางภาค").Cells(6, j + rw).Resize(55, 1).Value
            End With
            
          
        End If
    End With
        'r = r + 1
        'j = j + 1
    	tempBook.Close True
      '  tempBook.Close False
        fileName = Dir()
Loop
       
    Application.ScreenUpdating = True
    MsgBox ("ส่งคะแนนเข้า ปพ.5 Directory " & Sheets(p).Range("D1").Value & " เรียบร้อยแล้วค่ะ")
 
 End Sub

Code: Select all

dim c as integer
'...
rw = Application.Match(bookStr, .Range("G2:AF2"), 0) - 1
c = application.countif(.Range("G2:AF2"),bookStr)
If Err <> 0 Then
    MsgBox "File " & tempBook.Name & " not found in Rows 5."
    Err = 0
Else

With tempBook.Sheets("คะแนน1")
    .Range("AJ7:AJ62").resize(,c).Value = _
        thsBook.Worksheets("จปสคะแนนสอบกลางภาค").Cells(6, j + rw).Resize(55, c).Value
End With
'...

Code: Select all

'...
With tempBook.Sheets("คะแนน1")
    .Range("AJ7:AJ62").resize(,c).Value = _
        thsBook.Worksheets("จปสคะแนนสอบกลางภาค").Cells(6, j + rw).Resize(55, c).Value
                        With Cells
                                .Replace "0", ""
                                .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
                        End With
End With
'...

Code: Select all

dim c as integer
dim r as range
'...
rw = Application.Match(bookStr, .Range("G2:AF2"), 0) - 1
c = application.countif(.Range("G2:AF2"),bookStr)
If Err <> 0 Then
    MsgBox "File " & tempBook.Name & " not found in Rows 5."
    Err = 0
Else

With tempBook.Sheets("คะแนน1")
    .Range("AJ7:AJ62").resize(,c).Value = _
        thsBook.Worksheets("จปสคะแนนสอบกลางภาค").Cells(6, j + rw).Resize(55, c).Value
    for each r in .Range("AJ7:AJ62").resize(,c)
        if r.value = 0 then r.clearcontents
    next r
End With
'...