Copy ข้อมูลลงใน Call ที่ต้องการ ใช้VBA

[Totem]

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

ขอถามการใช้ VBA ในการ copy ไฟล์ Data ไป ไว้ที่ ไฟล์ Report โดยที่เงื่อนไขว่า เมื่อ copy ไปไว้ที่ไฟล์ Report

ที่ช่อง B2:B11 จะเกิดช่องว่างที่ B3,B4,B8,B10 (ช่องว่างที่เกิดขึ้นนั้นในแต่ละครั้งมีการผันแปรไปเรื่อย ๆ) ต้องการในช่องว่างนั้นให้ copy
ข้อความ B1 มาไว้ให้ครบทุกช่อง ซึ่งผมลองเขียนแล้วติดปัญหาการเขียนสูตรใน VBA ขึ้น Error ครับ ช่วยแก้ไขแนะนำด้วยครับ

code ที่ติดปัญหาตั้งแต้ Workbooks(Book_r).Sheets(Sheet_r).Range("b2").Formula = "=IF(b2="",b1,b2)" ลงมา

ขอบคุณครับ

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.xlsm"

    Sheet_r = "Report"
    Sheet_d = "Data"

    Workbooks(Book_d).Sheets(Sheet_d).Range("b2:b11").Copy
    Workbooks(Book_r).Sheets(Sheet_r).Range("b2").PasteSpecial Paste:=xlPasteValues
    Workbooks(Book_r).Sheets(Sheet_r).Range("b2").Formula = "=IF(b2="",b1,b2)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b3").Formula = "=IF(b3="",b1,b3)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b4").Formula = "=IF(b4="",b1,b4)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b5").Formula = "=IF(b5="",b1,b5)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b6").Formula = "=IF(b6="",b1,b6)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b7").Formula = "=IF(b7="",b1,b7)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b8").Formula = "=IF(b8="",b1,b8)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b9").Formula = "=IF(b9="",b1,b9)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b10").Formula = "=IF(b10="",b1,b10)"
    Workbooks(Book_r).Sheets(Sheet_r).Range("b11").Formula = "=IF(b11="",b1,b11)"
    
End Sub

[niwat2811]

ลองแบบนี้ดูว่าได้ตามต้องการไหมครับ

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
    Dim r As Range
    Dim lr As Long

    Book_r = "Report.xlsm"
    Book_d = "Data.xlsm"

    Sheet_r = "Report"
    Sheet_d = "Data"

    Workbooks(Book_d).Sheets(Sheet_d).Range("b2:b11").Copy
    Workbooks(Book_r).Sheets(Sheet_r).Range("b2").PasteSpecial Paste:=xlPasteValues
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For Each r In Range("B2:B" & lr)
        If r = "" Then
            r.Value = Range("B1").Value
        End If
    Next r
End Sub

[Totem]

ลองแบบนี้ดูว่าได้ตามต้องการไหมครับ

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
    Dim r As Range
    Dim lr As Long

    Book_r = "Report.xlsm"
    Book_d = "Data.xlsm"

    Sheet_r = "Report"
    Sheet_d = "Data"

    Workbooks(Book_d).Sheets(Sheet_d).Range("b2:b11").Copy
    Workbooks(Book_r).Sheets(Sheet_r).Range("b2").PasteSpecial Paste:=xlPasteValues
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For Each r In Range("B2:B" & lr)
        If r = "" Then
            r.Value = Range("B1").Value
        End If
    Next r
End Sub

ได้ตามที่ต้องการแล้วครับ ขอบคุณครับ ท่านniwat2811

ถ้าเป็นได้ช่วยอธิบาย เฉพาะบรรทัดนี้ lr = Range("A" & Rows.Count).End(xlUp).Row ได้ไหมครับ ขอบคุณครับ

[niwat2811]

เป็นการหาบรรทัดสุดท้ายที่มีข้อมูลอยู่ของคอลัมภน์ A ครับ

[Totem]

เป็นการหาบรรทัดสุดท้ายที่มีข้อมูลอยู่ของคอลัมภน์ A ครับ

ขอบคุณครับ