การใช้ Select Case_VBA copy ข้อมูลตามเงือนไข ไม่ทำงานครับ

[lotto009]

เรียนอาจาร์ยครับ
มาอีกแล้วขอความช่วยเหลือด้วยนะครับ ผมเอาcode vbaของอาจาร์ย มาประยุกต์
1.การใช้ Select Case_VBA copy ข้อมูลตามเงือนไข ไม่ทำงานครับ
Stepคือ
1.Copy ข้อมูล ตามชื่อด้านหน้าชื่อ"L23L23"
Worksheet("Input").Range(J:G to ) .Copy
Worksheet("Input").Range(์N:Q ).Past
2.Copy ข้อมูล ตามชื่อด้านหน้าชื่อ"L23L21"
Worksheet("Input").Range(J:G to ) .Copy
Worksheet("Input").Range(R:U ).Past
3.Copy ข้อมูล ตามชื่อด้านหน้าชื่อ"L23U21"
Worksheet("Input").Range(G:J to ) .Copy
Worksheet("Input").Range((Z:AC ).Past
4.มีคำนำหน้าไปเรื่อยๆแบบนี้ครับ
ผมแนบ codeมาด้วยนะครับ แต่ไม่มาเลย
ขอบพระคุณมากครับ
อาร์ต

Code: Select all

Private Sub CommandButton6_Click()
Dim r As Range, rAll As Range
    With Sheets("Input")
        Set rAll = .Range("G1", .Range("G" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
        Select Case r.Value
            Case "L23L23"
                Sheets("Input").Range("N" & Rows.Count).End(xlUp). _
                    Offset(1, 0).EntireRow = r.EntireRow.Value
            Case "L23U21"
                Sheets("Input").Range("R" & Rows.Count).End(xlUp). _
                    Offset(1, 0).EntireRow = r.EntireRow.Value
            Case "L23U08"
                Sheets("Input").Range("V" & Rows.Count).End(xlUp) _
                    .Offset(1, 0).EntireRow = r.EntireRow.Value
            Case "L23U09"
                Sheets("Input").Range("Z" & Rows.Count).End(xlUp) _
                    .Offset(1, 0).EntireRow = r.EntireRow.Value
            
            End Select
    Next r

End Sub

[snasui]

กรุณาบรรยายเป็นข้อความว่าต้องการจะทำอะไร หากถูกต้องจะได้คำตอบเป็นอย่างไร สามารถทำชีตคำตอบมาแสดงต่างหากจะได้เข้าถึงปัญหาโดยไวครับ

[lotto009]

เรียนอาจาร์ย
ขอโทษนะครับ ไฟล์ที่แนบไปไม่ละเอียด ผมแนบไฟล์ใหม่นะครับ
ชั้นตอน
Stepคือ
1.Copy ข้อมูล ตามชื่อด้านหน้าชื่อ"L23L23"
จาก Worksheet("Input").Range(J:G to ) .Copy วางไว้ที่ Worksheet("Input").Range(์N:Q ).Past

2.Copy ข้อมูล ตามชื่อด้านหน้าชื่อ"L23U21"
Worksheet("Input").Range(J:G to ) .Copy วางไว้ที่ Worksheet("Input").Range(R:U ).Past

3.Copy ข้อมูล ตามชื่อด้านหน้าชื่อ"L23U08"
Worksheet("Input").Range(G:J to ) .Copy วางไว้ที่ Worksheet("Input").Range((Z:AC ).Past

ทำงานไม่ได้ตามต้องการครับ
ขอพระคุณมากครับ

[snasui]

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

Code: Select all

For Each r In rAll
    Select Case r.Value
        Case "L23L23"
            Sheets("Input").Range("N" & Rows.Count).End(xlUp). _
                Offset(1, 0).Resize(1, 4).Value = r.Resize(1, 4).Value
        Case "L21U21"
            Sheets("Input").Range("R" & Rows.Count).End(xlUp). _
                Offset(1, 0).Resize(1, 4).Value = r.Resize(1, 4).Value
        Case "L21U08"
            Sheets("Input").Range("V" & Rows.Count).End(xlUp). _
                Offset(1, 0).Resize(1, 4).Value = r.Resize(1, 4).Value
    End Select
Next r

[lotto009]

ขอบพระคุณครับเป็นประโยชน์กับทุกคนในบอร์ดนี้เลย เพราะข้อมูลผมมีเยอะมาก
love-love