วางข้อมูลชุดที่ 2 แต่ไม่เริ่มที่แถวใหม่

[mabolosoda]

สวัสดีครับ ผมต้องการวางข้อมูลต่อกันภายในแถว ตั้งแต่เดือน 1/17 - 12/18 แต่พอรันมาโครข้อมูลไม่เริ่มที่แถวใหม่ แต่กลับวางทับที่เดิมตลอด แบบนี้ผมต้องแก้ Code ในส่วนไหนบ้างครับ ขอบคุณมากครับ

ไฟล์แนบ

Macro Excel - TEST.xlsm

ภาพนี้เป็นตัวอย่างผลที่อยากได้ครับ

Result.JPG

Code: Select all

Sub CopyToDB()

            Sheets("sheet1").Select
            RowEnd = Selection.End(xlDown).Row
            RowEnd = RowEnd + 1
            
                    Sheets("Sheet1").Select
                    Range("L3").Select
                    ColEnd = Selection.End(xlToRight).Column
                            
                            Sheets("database").Select
                            Sheets("database").Range("A2").Select
                            RowEndDB = RowEnd
                            RowEndDB = RowEndDB + 1


        For i = 12 To ColEnd

                
                Sheets("sheet1").Select
                Columns("K:K").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
         
                       
                        Range("L2").Select
                        Selection.Copy
                        Range("K3").Select
                        ActiveSheet.Paste
                        Application.CutCopyMode = False
                        Selection.AutoFill Destination:=Range("K3:K7754"), Type:=xlFillCopy
                        'Range("K:K7754").Select
            
            
                            '
                            Sheets("sheet1").Select
                            Range("A3:L3").Select
                            Range(Selection, Selection.End(xlDown)).Select
                            Selection.Copy
                            
                            
                            Range("A" & RowEndDB).Select
                            Worksheets("Database").Paste
                        
                            
                                Sheets("Sheet1").Select
                                Columns("K:L").Select
                                Selection.Delete Shift:=xlToLeft
                                
       Next i
End Sub

[DhitiBank]

ลองแบบนี้ครับ

Code: Select all

Sub CopyToDB()
    Sheets("sheet1").Select
    RowEnd = Range("a" & Rows.Count).End(xlUp).Row
    Set rDat1 = Range("a3:j" & RowEnd)
    Set rdateachmonth = Range("k3:k" & RowEnd)
    Set rAllMonth = Range("k2", Range("k2").End(xlToRight))
    Sheets("database").Select
    i = 0
    
    For Each r In rAllMonth
        rowend2 = Range("a" & Rows.Count).End(xlUp).Row + 1
        rDat1.Copy Range("a" & rowend2)
        r.Copy Range("a" & rowend2).End(xlToRight).Offset(, 1) _
            .Resize(rdateachmonth.Rows.Count, 1)
        rdateachmonth.Offset(, i).Copy Range("a" & rowend2).End(xlToRight) _
            .Offset(, 1)
        i = i + 1
    Next r
End Sub

[mabolosoda]

ขอบคุณ คุณDhitiBank มากครับ เป็นโค้ดที่เขียนใหม่สั้นดีจริงๆครับ ผมยังเป็นมือใหม่มากๆ ศึกษาได้ยังไม่ถึงเดือน บางส่วนบางบรรทัดอาจจะยังไม่ค่อยเข้าใจ โค้ดจะสั้นหรือยาวคงอยู่ที่คอนเซปที่เราคิดจะทำว่าเราจะทำอะไรจากข้อมูลที่มีและอยากได้ข้อมูลเป็นแบบไหนซึ่งวิธีคิดมีมากมาย ในช่วงที่รอคำตอบ ผมเลยพยายามทำจากโค้ดเก่าให้ได้ซึ่งตอนนี้สามารถ รัน จนผ่านแล้ว ขอขอบคุณพื้นที่ ที่ช่วยให้ผมหาคำตอบและตัวอย่าง และความรู้จากพี่ๆทุกคนที่ให้คำแนะนำมากครับ

อันนี้เป็นโค้ดที่ผมแก้เสร็จและรันจนผ่านแล้ว อาจจะยาวหน่อยแต่ขอแชร์ไว้ เผื่อมีท่านอื่นมีปัญหาแนวเดียวกับผมครับ

Code: Select all

Sub CopyToDB()
            
            Sheets("sheet1").Select
            Sheets("sheet1").Range("A2").Select
            RowEnd = Selection.End(xlDown).Row
            'RowEnd = RowEnd
            
                    'Sheets("Sheet1").Select
                    Range("L2").Select
                    ColEnd = Selection.End(xlToRight).Column
                            
                            Sheets("database").Select
                            Rows("2:100000").Select
                            Selection.Delete Shift:=xlUp
                            RowEndDB = 2
                            
        For i = 12 To ColEnd

                Sheets("sheet1").Select
                Columns("K:K").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
         
                        Range("L2").Select
                        Selection.Copy
                        Range("K3").Select
                        ActiveSheet.Paste
                        Application.CutCopyMode = False
                        Selection.AutoFill Destination:=Range("K3:K" & RowEnd), Type:=xlFillCopy
                        'Range("K3:K7754").Select

                            Sheets("sheet1").Select
                            Range("A3:L3").Select
                            Range(Selection, Selection.End(xlDown)).Select
                            Selection.Copy
                                 
                            Sheets("Database").Select
                            Range("A" & RowEndDB).Select
                            Worksheets("Database").Paste
                            Sheets("Database").Range("A1").Select
                            RowEndDB = Selection.End(xlDown).Row
                            RowEndDB = RowEndDB + 1
                            
                                Sheets("Sheet1").Select
                                Columns("K:L").Select
                                Selection.Delete Shift:=xlToLeft
                          
       Next i
End Sub

[DhitiBank]

ยินดีครับ และหวังว่าจะพอช่วยได้บ้าง ผมขออภัยที่ไม่ได้เอาโค้ดเก่ามาแก้ เพราะผมลองรันโค้ดทีละบรรทัดพบว่าเริ่มมีการแทรกและลบคอลัมน์ในฐานข้อมูล โดยส่วนตัวแล้วผมคิดว่าไม่ควรทำอะไรกับฐานข้อมูลเดิม ผมเลยเขียนโค้ดใหม่ครับ

ในอินเทอร์เน็ตมีหลายเว็บไซต์ที่สอนและให้ตัวอย่างการใช้งานเกี่ยวกับโค้ดครับ หากสนใจลองเข้าไปดูในลิ้งค์ต่างๆ ข้างล่างนี้ นอกจากบอร์ดของอาจารย์คนควนแล้วส่วนใหญ่ผมก็เข้าไปดูในเว็บพวกนี้ครับ

เริ่มต้น
https://www.techonthenet.com/excel/formulas/index.php
http://www.excel-easy.com/vba.html

ยากขึ้นมาอีก
http://spreadsheetpage.com/index.php/tips
https://chandoo.org/wp/excel-vba/
https://www.thespreadsheetguru.com/excel-vba/