เปิด sheet ข้ามไฟล์ VBA

[Jazmin]

โค้ดที่ใช้อยู่ เปิดไฟล์ Testcompare sheet(Format) มาที่ไฟล์ Openimport sheet(import) มันต้องเลือกเซลล์ข้อมูลที่ต้องการและเลือกเซลล์ที่จะเอาข้อมูลลงค่ะ พอดึงมาแล้ว ข้อมูลกลายเป็น 0 ค่ะ พอมีวิธีแก้มั้ยคะ อยากให้ไม่ต้องเลือกเซลล์ข้อมูล เอาแต่ข้อมูล (A:Y)ไม่เอาหัวตารางมาค่ะ ข้อมูลเราไม่ทราบจำนวนที่แน่ชัด แล้วลงข้อมูลที่ ไฟล์ Openimport sheet(import) ที่ cell (B10) ค่ะ

Code: Select all

Private Sub CommandButton1_Click()

    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim rngSourceRange As Range
    Dim rngDestination As Range
    Set wkbCrntWorkBook = ActiveWorkbook
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "E:", "*.xlsx"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
            wkbCrntWorkBook.Activate
            Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="B10", Type:=8)
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireColumn.AutoFit
            wkbSourceBook.Close False
        End If
    End With



End Sub

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Private Sub CommandButton1_Click()
    Dim strSourceBook As String
    Dim wkbSourceBook As Workbook
    Dim wkbCrntWorkBook As Workbook
    
    Set wkbCrntWorkBook = ThisWorkbook
    strSourceBook = Application.GetOpenFilename(FileFilter:="Excel file(*.xls*),*.xls*", _
        Title:="Please select soruce file.", MultiSelect:=False)
    If strcourcebook = "False" Then Exit Sub
    Set wkbSourceBook = Workbooks.Open(strSourceBook, False)
    With wkbSourceBook.Worksheets("Format")
        Set rngSourceRange = .Range("a2", .Range("a" & .Rows.Count).End(xlUp)).Resize(, 26)
        rw = rngSourceRange.Rows.Count
        col = rngSourceRange.Columns.Count
    End With
    With wkbCrntWorkBook.Worksheets("import")
        .Range("b10").Resize(rw, col).Value = rngSourceRange.Value
        .Range("b10").CurrentRegion.EntireColumn.AutoFit
    End With
    wkbSourceBook.Close False
End Sub

[Jazmin]

ขอบคุณค่ะ จะนำไปประยุกต์ใช้กับงานอื่นด้วยค่ะ