Copy ข้อมูลจากบาง column ไปอีก sheet แบบ Auto

[::mangpor::]

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

ต้องการ copy ข้อมูลจาก sheet "Input" ไปโชว์ที่ sheet "Result" ตามตัวอย่างไฟล์แนบนะค่ะ

ขอบคุณมากค่ะ

[snasui]

ยังไม่กระจ่างครับ สำหรับการ Link ข้อมูลแบบไม่มีเงื่อนไข สามารถทำดังนี้

1. คีย์เครื่องหมาย = ที่เซลล์ปลายทาง
2. คลิกเซลล์ต้นทางที่ต้องการเชื่อมโยง ข้อมูลก็จะเชื่อมโยงกัน
3. Copy สูตรไปยังพื้นที่เป้าหมายอื่น ๆ
4. ลบคอลัมน์ที่ไม่ต้องการทิ้งไป

[::mangpor::]

ขออภัยค่ะที่บอกไม่กระจ่าง คือข้อมูลใน sheet จะเพิ่มขึ้นเรื่อย น่ะค่ะ ข้อมูลที่เพิ่มเข้ามาจะเป็นการ copy จาก file อื่นมาใส่ทับน่ะค่ะโดยที่ตำแหน่ง column ทุกอย่างจะยังคงเดิม

[snasui]

เท่าที่อ่านดูคงต้องทำด้วย VBA กรณี Copy จากไฟล์อื่นต้องระบุชื่อไฟล์ต้นทางมาด้วยเพื่อจะเขียนเข้าไปใน Code ครับ

[::mangpor::]

ขอบคุณค่ะ...ตอบรวดเร็วทันใจดีจังค่ะ อยากได้สูตรแบบเฉพาะ Sheet นี้น่ะค่ะ ไม่ทราบจะทำได้หรือเปล่า เพราะข้อมูลที่จะ copy มาจะมา paste วางไว้เองน่ะค่ะ

[snasui]

ผมเขียน Code ให้แล้วตามด้านล่าง ลองทดสอบตามไฟล์แนบครับ

Code: Select all

Sub CopyPasteData()
Dim r1 As Range, r2 As Range, rt As Range, rs As Range
With Worksheets("Input")
    Set r1 = .Range("A3", .Range("A65536").End(xlUp))
    Set r2 = r1.Offset(0, 4).Resize(, 4)
    Set rs = Union(r1, r2)
End With
    Set rt = Worksheets("Results").Range("A65536").End(xlUp).Offset(1, 0)
    rs.Copy rt
    Application.CutCopyMode = False
    MsgBox "Finish."
End Sub

[::mangpor::]

ขอบคุณมากๆ ค่ะ เยี่ยมเลยค่ะ อยากสอบถามอีกนิดนึงค่ะ คือจริงๆ column จากไฟล์จริงๆ จะเยอะมากกว่านี้อีกน่ะค่ะ ถ้าต้องการเพิ่มจำนวน column ที่จะ copy มาที่ sheet result น่ะค่ะ ต้องเพิ่มตรงไหนค่ะ

**ขออภัยนะค่ะ พอดีไม่เป็นเรื่อง VBA จริงๆ รบกวนด้วยค่ะ **

[snasui]

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

Code: Select all

Dim r1 As Range, r2 As Range, rt As Range, rs As Range
With Worksheets("Input")
    Set r1 = .Range("A3", .Range("A65536").End(xlUp))
    Set r2 = r1.Offset(0, 4).Resize(, 4)
    Set rs = Union(r1, r2)
End With

หากลองแล้วไม่สำเร็จก็ส่งไฟล์ตัวอย่างที่เป็นตัวแทนของข้อมูลจริงมาใหม่ครับ

[::mangpor::]

งั้นรบกวนทำที่ไฟล์นี้น่ะค่ะ ขอบคุณค่ะ

[snasui]

สามารถปรับปรุง Code เป็นตามด้านล่าง ดูไฟล์แนบประกอบครับ

Code: Select all

Sub CopyPasteData()
Dim r As Range, rt As Range, rs As Range
With Worksheets("Input")
    Set r = .Range("B1:D1, T1, V1:X1, Z1:AF1" _
    & ", AH1:AI1, AN1, AP1:AW1, AY1:BA1" _
    & ", BD1, BG1:BM1, BO1:BP1, BR1:BS1" _
    & ", BU1:BV1, BX1, CA1, CD1:CH1")
     r.EntireColumn.Hidden = True
    Set rs = .Range("A3:CH" & .Range("A65536").End(xlUp).Row) _
        .SpecialCells(xlCellTypeVisible)
End With
    Set rt = Worksheets("Result").Range("A65536").End(xlUp).Offset(1, 0)
    rs.Copy rt
    r.EntireColumn.Hidden = False
    Application.CutCopyMode = False
    MsgBox "Finish."
End Sub

[::mangpor::]

ขอบคุณมากๆ ค่ะ ใช้ได้แล้วค่ะ

[lotto009]

ขออนุญาตเอาไปใช้ด้วยนะครับอาจาร์ย แหะแหะ