การคัดลอกข้อมูลข้ามชีท

[chanakan Cherdchoo]

สวัสดีค่ะ อยากสอบถามสูตรในการ copyข้อมูลไปวางในอีก sheet โดยถ้าต้องการ copy ข้อมูลทั้งหมด 19 rows ให้ไปวางไว้อีกsheet หนึ่งโดยที่ครั้งถัดไปอยากให้ไปวางในคอลัมน์ถัดไปค่ะ เลยอยากรบกวนมาสอบถามสูตรเบื้องต้นเคยใช้แต่สูตรนี้ค่ะ

Code: Select all

Dim mylastrow As Long
    mylastrow = Sheets("Hatching").Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("B9:B10").Copy
    Sheets("Hatching").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
    

แต่สูตรอันนี้มันวางได้แค่ต่อกันไปในแนวตั้งค่ะ ขอรบกวนสอบถามนิดนึงนะคะ ขอบคุณมากๆค่ะ
ต้องการให้ก็อปปี้ไปวางไว้ในสองที่ค่ะอีกที่คือชีท report ค่ะ โดยให้ข้อมูลก็อปปี้ไปยังวันที่ถัดๆมาเป็นคอลัมน์ถัดไปค่ะ

[puriwutpokin]

ควรแนบไฟล์ตัวอย่าง และ วางโค้ดตามรูปแบบ ในกฏข้อ5 ด้วยครับ จะได้สะดวกต่อการตอบของเพื่อนๆสมาชิกครับ

[chanakan Cherdchoo]

ขอบคุณสำหรับคำแนะนำนะคะ ทำการแก้ไขเรียบร้อยแล้วค่ะ

[snasui]

ช่วยอธิบายเพิ่มเติมว่า Copy ข้อมูลจากที่ใดไปไว้ที่ใด Code ที่เขียนเอาไว้แล้วชื่อ Procedure ว่าอะไร อยู่ใน Module ใดครับ

นอกจากนี้ Code ที่เขียนมาด้วยนั้นจะต้องสอดคล้องกับชื่อชีตที่มีอยู่จริงในไฟล์แนบครับ

[chanakan Cherdchoo]

ต้องการ Copy sheetM2 range(L9:L18)ไปไว้ที่ sheet report ช่อง I10,12,14,16,18,20,22,24,26,28 ค่ะ แล้วครั้งถัดไปที่กดบันทึกข้อมูลอยากให้ไปอยู่ในคอลัมน์ถัดไปค่ะ

Code: Select all

Dim mylastrow As Long
    mylastrow = Sheets("report").Range("I" & Rows.Count).End(xlUp).Row + 1
    Range("L9:L18").Copy
    Sheets("Report").Range("I" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
    

ถ้าใช้สูตรนี้ครั้งถัดไปมันจะไปวางต่อที่คอลัมน์ I เหมือนเดิมค่ะ เลยอยากปรึกษาการแก้ไขโค้ดให้เป็นแบบที่ต้องการค่ะ

[snasui]

แนบไฟล์ล่าสุดที่มี Code นี้มาด้วย จะได้ตอบต่อไปจากนั้น กรุณาแจ้งด้วยว่า Code อยู่ใน Module ใด จะได้เข้าถึง Code โดยไวครับ

[chanakan Cherdchoo]

code อยู่ใน moduleที่ 7 ค่ะ

[snasui]

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

Code: Select all

Sub Report_Click()
'    Dim mylastrow As Long
    Dim lstRng As Range
    Dim rng As Range

'    mylastrow = Sheets("report").Range("H" & Rows.Count).End(xlUp).Row + 1
    With Sheets("M2")
        For Each rng In .Range("h9,i9,l9")
            With Sheets("Report")
                Set lstRng = .Cells(10, .Columns.Count).End(xlToLeft).Offset(0, 1)
            End With
            rng.Resize(10).Copy
            lstRng.PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        Next rng
    End With
'    Range("H9:H18").Copy
'    Sheets("Report").Range("H" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'
'    mylastrow = Sheets("report").Range("I" & Rows.Count).End(xlUp).Row + 1
'    Range("I9:I18").Copy
'    Sheets("Report").Range("I" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'
'    mylastrow = Sheets("report").Range("J" & Rows.Count).End(xlUp).Row + 1
'    Range("L9:L18").Copy
'    Sheets("Report").Range("J" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
End Sub

[chanakan Cherdchoo]

ถ้าเราอยากให้ข้อมูลมาวางในคอลัมน์แล้ววางเป็นเซลล์ H10,H12,H14,H16,H18.... เราสามารถเขียนให้ข้อมูลที copy มาวางเว้นกันได้ไหมคะ

[snasui]

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

Code: Select all

'Other code
Dim lstRng As Range
Dim rng As Range, j As Integer
Dim r As Range
'    mylastrow = Sheets("report").Range("H" & Rows.Count).End(xlUp).Row + 1
With Sheets("M2")
    For Each rng In .Range("h9,i9,l9")
        With Sheets("Report")
            Set lstRng = .Cells(10, .Columns.Count).End(xlToLeft).Offset(0, 1)
        End With
        j = 0
        For Each r In rng.Resize(10)
            lstRng.Offset(j, 0).Value = r.Value
            j = j + 2
        Next r
'            rng.Resize(10).Copy
'            lstRng.PasteSpecial xlPasteValues
'            Application.CutCopyMode = False
    Next rng
End With
'Other code

ในโอกาสถัดไปจะต้องปรับปรุง Code มาเองก่อน ติดตรงไหนค่อยถามกันต่อครับ

[chanakan Cherdchoo]

ขอบคุณมากๆเลยนะคะอาจารย์ แก้ไขแล้วนำมาปรับใช้เรียบร้อยแล้วค่ะ