Snasui Excel Forum

Posted: **Thu Jul 08, 2021 5:03 pm**

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

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

Posted: **Thu Jul 08, 2021 5:13 pm**

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

Posted: **Fri Jul 09, 2021 8:14 am**

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

Posted: **Fri Jul 09, 2021 11:13 am**

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

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

Posted: **Fri Jul 09, 2021 11:56 am**

ใช้ได้ค่ะ แต่ถ้ามีการเพิ่มชีทเป็น 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

Posted: **Fri Jul 09, 2021 12:35 pm**

Amorrat wrote: Fri Jul 09, 2021 11:56 am ใช้ได้ค่ะ แต่ถ้ามีการเพิ่มชีทเป็น 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

Posted: **Fri Jul 09, 2021 1:19 pm**

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

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

Snasui Excel Forum

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

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

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

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

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

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

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

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