สอบถามปัญหาการใช้ VBA copy ข้อมูลจากชีทอื่นมาต่อท้ายแถวในชีทหลัก

[9KiTTi]

ขออนุญาติสอบถามกรณีใช้ VBA เพื่อ copy cell จากชีทที่นำเข้า คือ A1:Y1 ของทุกชีท มาวางที่แถว B5 ของชีท Main จนครบทุกชีทที่นำเข้า แต่หลังจากรัน VBA ข้อมูลที่ copy มา ไม่ถูกวางไว้ที่ B5 ต่อๆกันมา แต่จะข้ามไปวางที่ cell อื่นแทน รบกวนขอคำแนะนำด้วยครับ

Code: Select all

Sub copyunit()
    Dim s As Worksheet
    Dim M As Worksheet
    Set M = Sheets("Main")
    Dim lr As Long
    For Each s In Worksheets
        
        s.Range("A1:Y1").Copy
        
        lr = M.Range("B" & Rows.Count).End(xlUp).Row + 1
        M.Range("B5" & lr).PasteSpecial xlPasteValues
    Next s
    'MsgBox ("Completed")
End Sub

[snasui]

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

Code: Select all

'Other code
For Each s In Worksheets
    If s.Name <> M.Name Then
        s.Range("A1:Y1").Copy
        lr = M.Range("c" & Rows.Count).End(xlUp).Row + 1
        M.Range("B" & lr).PasteSpecial xlPasteValues
    End If
Next s
'Other code

[9KiTTi]

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

Code: Select all

'Other code
For Each s In Worksheets
    If s.Name <> M.Name Then 'ชื่อไม่ตรงกัน
        s.Range("A1:Y1").Copy
        lr = M.Range("c" & Rows.Count).End(xlUp).Row + 1 'แถวสุดท้ายที่มีข้อมูล
        M.Range("B" & lr).PasteSpecial xlPasteValues
    End If
Next s
'Other code

ขออนุญาตครับ เนื่องจากความผิดพลาดของผมเอง ผมได้เพิ่มแถวสูตรรวมไว้ที่แถว B32 : Z32 ทำให้copy ข้อมูลไปต่อที่แถว 32 พยายามปรับแก้แล้วครับ แต่ยังไม่ได้ รบกวนชี้แนะด้วยครับ ขอบพระคุณครับ

[snasui]

ปรับการกำหนดค่าให้กับตัวแปร lr เป็น lr = M.Range("C31").End(xlUp).Row + 1 ครับ

[9KiTTi]

ปรับการกำหนดค่าให้กับตัวแปร lr เป็น lr = M.Range("C31").End(xlUp).Row + 1 ครับ

ผมไปปรับแก้ที่ตำแหน่งอื่นที่ไม่ใช่ตรงนี้ครับ ขอบพระคุณครับอาจารย์

[9KiTTi]

ขออนุญาตครับ ผมได้เพิ่มคอลลัม์ C เข้ามา ทำให้รัน VB แล้วไม่สามารถ copy ข้อมูลจากชีทอื่นมาวางที่ชีท Main ตั้งแต่คอลัมม์ B ลงมาจนครบทุกชีทไม่ได้ รบกวนขอคำแนะด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub copy_unit()
    Dim s As Worksheet
    Dim M As Worksheet
    Set M = Sheets("Main")
    Dim lr As Long
For Each s In Worksheets
    If s.Name <> M.Name Then 'ชื่อไม่ตรงกัน
        s.Range("A1:Z1").Copy
        lr = M.Range("C34").End(xlUp).Row + 1
        M.Range("B" & lr).PasteSpecial xlPasteValues
    End If
Next s
    'MsgBox ("Completed")
End Sub

[snasui]

เกิดจากหัว Report มีหลายบรรทัด มีการ Merge เอาไว้ การหาค่าบรรทัดว่างเพื่อวางข้อมูลจะผิดพลาด วิธีการด้านล่างเป็นการปรับตัวแปรให้เป็นบรรทัดที่พร้อมวางข้อมูลครับ

Code: Select all

'Other code
For Each s In Worksheets
    If s.Name <> M.Name Then 'ª×èÍäÁèµÃ§¡Ñ¹
        s.Range("A1:Z1").Copy
        lr = M.Range("C34").End(xlUp).Row + 1
        if lr < 5 then lr = 5
        M.Range("B" & lr).PasteSpecial Paste:=xlPasteValues
    End If
Next s
'Other code

[9KiTTi]

เกิดจากหัว Report มีหลายบรรทัด มีการ Merge เอาไว้ การหาค่าบรรทัดว่างเพื่อวางข้อมูลจะผิดพลาด วิธีการด้านล่างเป็นการปรับตัวแปรให้เป็นบรรทัดที่พร้อมวางข้อมูลครับ

Code: Select all

'Other code
For Each s In Worksheets
    If s.Name <> M.Name Then 'ª×èÍäÁèµÃ§¡Ñ¹
        s.Range("A1:Z1").Copy
        lr = M.Range("C34").End(xlUp).Row + 1
        if lr < 5 then lr = 5
        M.Range("B" & lr).PasteSpecial Paste:=xlPasteValues
    End If
Next s
'Other code

ขอบพระคุณครับอาจารย์ ผมนำไปใช้ในงานอื่นได้พอดีเลยครับ