สอบถาม CodeVB copy ข้อมูล

[tigerwit]

จากไฟล์ที่แนบมา ต้องการใช้ CodeVB copy ข้อมูลจาก sheet2 มาวางใน sheet1
แต่มีปัญหาว่าไม่สามารถ Copy มาได้หมด เนื่องจากใน Sheet1 มีเซลที่ถูกผสานเซลไว้
พอจะมีวิธีการแก้ไขได้หรือไม่ครับ (โดยยังผสานเซลนั้นเหมือนเดิม)

Code: Select all

Sub Macro1()

    Sheets("Sheet2").Select
    Range("B3:D5").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D3").Select
    Sheets("Sheet2").Select
    Range("E3:E5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("D3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

[snasui]

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

Code: Select all

Sub Macro1()
    Dim sr As Range, tg As Range, i As Integer
    
    Set tg = Sheets("Sheet1").Range("A3:d5")
    Set sr = Sheets("Sheet2").Range("b3:e5")
    i = 1
    For Each r In tg
        If r.MergeCells Then
            r.MergeArea.ClearContents
            r.MergeArea.Value = sr(i).Value
        Else
            r.ClearContents
            r.Value = sr(i).Value
        End If
        i = i + 1
    Next r
End Sub

[tigerwit]

ขอบคุณครับผม
กรณีที่เราเปลี่ยนจากการดึงข้อมูลมาจากชีทใน Workbook เดียวกัน
เป็นการดึงข้อมูลมาจากไฟล์ .csv จะต้องปรับ Code อย่างไรครับ

Code: Select all

Sub Macro2()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  Dim sr As Range, tg As Range, i As Integer
  
  If MsgBox("คุณต้องการนำเข้าข้อมูลใช่หรือไม่?", 36, "ยืนยันการนำบันทึกรับจ่ายเงิน") = 6 Then
    fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
  Set tg = ActiveSheet.Range("A3:D5")
  Set sr = wbTextImport.Worksheets("data").Range("A2:D4")
    i = 1
    For Each r In tg
        If r.MergeCells Then
            r.MergeArea.ClearContents
            r.MergeArea.Value = sr(i).Value
        Else
            r.ClearContents
            r.Value = sr(i).Value
        End If
        i = i + 1
    Next r
        End If
End Sub

[snasui]

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

Code: Select all

Sub Macro2()
    Dim fileToOpen As Variant
    Dim fileFilterPattern As String
    Dim wsMaster As Worksheet
    Dim wbTextImport As Workbook
    Dim sr As Range, tg As Range, i As Integer
    
    Set tg = ActiveSheet.Range("A3:D5")
    If MsgBox("คุณต้องการนำเข้าข้อมูลใช่หรือไม่?", 36, "ยืนยันการนำบันทึกรับจ่ายเงิน") = 6 Then
        fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
        Set wbTextImport = Workbooks.Open(fileToOpen)
        Set sr = wbTextImport.Worksheets("data").Range("A2:D4")
        i = 1
        For Each r In tg
            If r.MergeCells Then
                r.MergeArea.ClearContents
                r.MergeArea.Value = sr(i).Value
            Else
                r.ClearContents
                r.Value = sr(i).Value
            End If
            i = i + 1
        Next r
    End If
    wbTextImport.Close False
End Sub