รบกวนสอบถามค่ะ ไฟล์ที่ importมา แสดงผลแค่ชีทเดียว

[Amorrat]

ต้องปรับเปลี่ยน code ตรงไหนบ้างคะ
ขอบคุณค่ะ

Code: Select all

Sub Button1_Click()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A2:c350").Copy
  
        ThisWorkbook.Worksheets("1").Range("DI12").PasteSpecial xlPasteValues 
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
    
   
End Sub

[snasui]

กรุณาแนบไฟล์ทั้งไฟล์โปรแกรมและไฟล์ที่เป็นข้อมูลต้นทาง เพื่อน ๆ จะได้ช่วยกันทดสอบให้ได้ครับ

[Amorrat]

แนบไฟล์มาแล้วค่ะ
ตอนนี้ import ไฟล์วันไหนก็จะแสดงแค่ชีทที่1 ค่ะ

[logic]

แบบนี้ไหมครับ

Code: Select all

Sub Button1_Click()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A2:c350").Copy
        If OpenBook.Name = "1.7.64.xlsx" Then
            ThisWorkbook.Worksheets("1").Range("DI12").PasteSpecial xlPasteValues
        Else
            ThisWorkbook.Worksheets("2").Range("DI12").PasteSpecial xlPasteValues
        End If
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
   
End Sub

[Amorrat]

ใช้ได้ค่ะ แต่ถ้ามีการเพิ่มชีทเป็น 3 ถึง 31 ต้องปรับแก้ส่วนไหนเพิ่มค่ะ
รวบกวนอีกครั้งค่ะ

Code: Select all

Sub Button1_Click()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A2:c350").Copy
        If OpenBook.Name = "1.7.64.xlsx" Then
            ThisWorkbook.Worksheets("1").Range("DI12").PasteSpecial xlPasteValues
        Else
            ThisWorkbook.Worksheets("2").Range("DI12").PasteSpecial xlPasteValues
        End If
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
   
End Sub

ลองเพิ่มชีทชื่อ 3 ได้ปรับโค้ดเป็นดังนี้ แต่ error ค่ะ

Code: Select all

Sub Button1_Click()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A2:c350").Copy
        If OpenBook.Name = "1.7.64.xlsx" Then
            ThisWorkbook.Worksheets("1").Range("DI12").PasteSpecial xlPasteValues
        Else
            ThisWorkbook.Worksheets("2").Range("DI12").PasteSpecial xlPasteValues
        Else
            ThisWorkbook.Worksheets("3").Range("DI12").PasteSpecial xlPasteValues    
        End If
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
   
End Sub

[logic]

ใช้ได้ค่ะ แต่ถ้ามีการเพิ่มชีทเป็น 3 ถึง 31 ต้องปรับแก้ส่วนไหนเพิ่มค่ะ

ทดสอบอันนี้ดูครับ

Code: Select all

Sub Button1_Click()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A2:c350").Copy
  
        ThisWorkbook.Worksheets(Left(OpenBook.Name, InStr(OpenBook.Name, ".") - 1)).Range("DI12").PasteSpecial xlPasteValues
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
    
End Sub

[Amorrat]

โค้ดนี้ใช้ได้ค่ะ ขอบคุณมากค่ะ

Code: Select all

Sub Button1_Click()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A2:c350").Copy
  
        ThisWorkbook.Worksheets(Left(OpenBook.Name, InStr(OpenBook.Name, ".") - 1)).Range("DI12").PasteSpecial xlPasteValues
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
    
End Sub