Copy file โดยใช้ Vba ให้ลงในช่องว่างที่ต้องการ

[Totem]

เรียน อาจารย์และเพื่อนสมาชิก

ผมใช้ Vba Copy จาก sheet data ไป sheet ข้อมูล แล้ว copy ได้ไม่ครบ คือไม่สามารถ copy ชื่อสินค้า อื่นๆ ให้ลงในช่องว่างที่ต้องการได้

ช่วยดู code ตัวอย่างนี่ด้วยครับ

Code: Select all

Sub Report()
    Dim Book_r As String
    Dim Book_d As String
   

    Dim Sheet_r As String
    Dim Sheet_d As String
    
 

    Book_r = "report.xlsm"
    Book_d = "data.xlsx"

    Sheet_r = "ข้อมูล"
    Sheet_d = "data"


     
    Workbooks(Book_r).Sheets(Sheet_r).Range("a1:c8").ClearContents
    Workbooks(Book_d).Sheets(Sheet_d).Range("a2:c9").Copy
    Workbooks(Book_r).Sheets(Sheet_r).Range("b3").PasteSpecial Paste:=xlPasteValues
    
    Ir = Range("d" & Rows.Count).End(xlUp).Row
    
    For Each r In Workbooks(Book_r).Sheets(Sheet_r).Range("c1:c" & Ir)

         If r = "" Then
        
            r.Value = Range("g2").Value
            
        End If
        
    Next r
        
End Sub

ติดตรงนี้ครับ ไม่ทำงานตามที่ต้องการ

Code: Select all

Ir = Range("d" & Rows.Count).End(xlUp).Row
    
    For Each r In Workbooks(Book_r).Sheets(Sheet_r).Range("c1:c" & Ir)

         If r = "" Then
        
            r.Value = Range("g2").Value
            
        End If
        
    Next r
        
End Sub

[snasui]

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

Code: Select all

Sub Report()

    Dim Book_r As String, Sheet_r As String
    Dim Book_d As String, Sheet_d As String

    Book_r = "report.xlsm": Sheet_r = "¢éÍÁÙÅ"
    Book_d = "data.xlsx": Sheet_d = "data"
    
    With Workbooks(Book_r).Sheets(Sheet_r)
    
        .Range("a1:c8").ClearContents
        Workbooks(Book_d).Sheets(Sheet_d).Range("a2:c9").Copy
        .Range("b3").PasteSpecial Paste:=xlPasteValues
        
        Ir = .Range("d" & .Rows.Count).End(xlUp).Row
        
        For Each r In .Range("c3:c" & Ir)
             If r = "" Then
                r.Value = .Range("g2").Value
            End If
        Next r
        
    End With
    
End Sub

[Totem]

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

Code: Select all

Sub Report()

    Dim Book_r As String, Sheet_r As String
    Dim Book_d As String, Sheet_d As String

    Book_r = "report.xlsm": Sheet_r = "¢éÍÁÙÅ"
    Book_d = "data.xlsx": Sheet_d = "data"
    
    With Workbooks(Book_r).Sheets(Sheet_r)
    
        .Range("a1:c8").ClearContents
        Workbooks(Book_d).Sheets(Sheet_d).Range("a2:c9").Copy
        .Range("b3").PasteSpecial Paste:=xlPasteValues
        
        Ir = .Range("d" & .Rows.Count).End(xlUp).Row
        
        For Each r In .Range("c3:c" & Ir)
             If r = "" Then
                r.Value = .Range("g2").Value
            End If
        Next r
        
    End With
    
End Sub

ปรับ Code แล้วครับใช้ได้ตามต้องการครับ ขอบคุณครับ

มีคำถามไม่เข้าใจครับ Code ก่อนหน้านี่ เวลา Run Code ที่ sheet ข้อมูล สามารถ copy ไปวาง เซลล์ที่ว่างได้ แต่พอผม ไปสร้างปุ่มไว้ที่ sheet report แล้ว Run กลับไม่ copy มา อาจารย์ ช่วยอธิบายพอสังเขป ขอบคุณครับ

[snasui]

อธิบายด้วยคำถามครับ

จาก Code Ir = Range("d" & Rows.Count).End(xlUp).Row ตั้งใจให้ Ir เป็นการรับค่าจากไฟล์ใด ชีทใดครับ

โปรแกรมจะทราบได้อย่างไรว่า Range("d" & Rows.Count).End(xlUp).Row เป็นของไฟล์ใด ชีทใดครับ

ดังนั้น การจะให้โปรแกรมทำงานได้ตรงกับที่ต้องการตัวแปร Ir จะต้องรับค่ามาจากไฟล์ที่ถูกต้อง ชีทที่ถูกต้อง ซึ่งต้องระบุไฟล์ ระบุชีท กำกับเข้าไปด้วย เป็นต้นครับ

[Totem]

อธิบายด้วยคำถามครับ

จาก Code Ir = Range("d" & Rows.Count).End(xlUp).Row ตั้งใจให้ Ir เป็นการรับค่าจากไฟล์ใด ชีทใดครับ

โปรแกรมจะทราบได้อย่างไรว่า Range("d" & Rows.Count).End(xlUp).Row เป็นของไฟล์ใด ชีทใดครับ

ดังนั้น การจะให้โปรแกรมทำงานได้ตรงกับที่ต้องการตัวแปร Ir จะต้องรับค่ามาจากไฟล์ที่ถูกต้อง ชีทที่ถูกต้อง ซึ่งต้องระบุไฟล์ ระบุชีท กำกับเข้าไปด้วย เป็นต้นครับ

อืม ครับพอเข้าใจแล้วครับ ขอบคุณครับ