Copy Sheet1 ไป Sheet2 แบบข้าม workbook แบบrealtime

[snasui]

Mark Code ด้านล่างเป็น Comment ครับ

Code: Select all

'Private Sub Worksheet_Change(ByVal Target As Range)
'    Application.EnableEvents = False
'    Workbooks.Open Filename:="c:\Plan\planning.xlsx"
'    Workbooks("planning.xlsx").Worksheets("M01").Range("A3:Q4000").Value = _
'        Workbooks("plannew.xlsm").Worksheets("M01").Range("A3:Q4000").Value
'    ActiveWindow.Close True
'    Application.EnableEvents = True
'End Sub

จากนั้นปรับ Code จากการคลิกปุ่ม บันทึกข้อมูลเป็น

Code: Select all

Private Sub CommandButton1_Click()
    Dim InputRange As Range, Target As Range
    Application.EnableEvents = False
    Set InputRange = Range("c2:c17")
    Set Target = Worksheets([C17].Value).Range("b" & Rows.Count).End(xlUp)
    For Each cll In InputRange
        Target.Offset(1, c).Value = cll.Value
        c = c + 1
    Next
    Application.EnableEvents = True
    Workbooks.Open Filename:="c:\Plan\planning.xlsx"
    Workbooks("planning.xlsx").Worksheets("M01").Range("A3:Q4000").Value = _
        Workbooks("plannew.xlsm").Worksheets("M01").Range("A3:Q4000").Value
    Workbooks("planning.xlsx").Close True
    Range("c2:c17").Select
    MsgBox "จัดเก็บข้อมูลเรียบร้อยแล้ว"
    Selection.ClearContents
    Range("C2").Select
    ThisWorkbook.Save
End Sub

[sakajohn]

Mark code ที่เป็น comment ใส่ไว้ที่ไหนครับ

[snasui]

Code เดิมอยู่ที่ใดก็ไปที่นั่นแล้วทำการ Mark ให้เป็น Comment (ใส่เครื่องหมาย ' เข้าไปด้านหน้า) หรือลบ Code ทิ้งไปก็ได้ ไม่ได้ให้เอาไปใส่เพิ่มครับ

[sakajohn]

ได้แล้วครับ ขอบคุณมากครับ ผมขอถามเพิ่มครับ กรณีที่ workbook สำหรับใส่ข้อมูล มีหลาย worksheet เช่นถ้าข้อมูลบันทึกที่ M01 ก็ไปใส่ค่าที่ workbook planning.xlsx ที่ sheet M01 ถ้าข้อมูลบันทึกที่ M02 ก็ไปใส่ค่าที่ workbook planning.xlsx ที่ sheet M02 เป็นต้น ผมต้องใส่สูตรอย่างไรครับ ตอนแรกที่กำหนดไว้ คือใช้ code แต่ละ sheetไปเลย เช่น sheet M01 ก็เขียน Code ที่ M01 ,sheet M02 ก็เขียน Code ที่ M02 ครับ

[sakajohn]

ได้แล้วครับ

Code: Select all

Workbooks("planning.xlsx").Worksheets("M01").Range("A3:Q4000").Value = _
        Workbooks("plannew.xlsm").Worksheets("M01").Range("A3:Q4000").Value
    Workbooks("planning.xlsx").Worksheets("M02").Range("A3:Q4000").Value = _
        Workbooks("plannew.xlsm").Worksheets("M02").Range("A3:Q4000").Value

[lotto009]

เรียนอาจาร์ยครับ
ผมมี สองไฟล์
1.inputfile.xlsx
2.outputfile.xlsm
ต้องการcopyบางคอลลัมมาไว้ที่ outputfile.xlsm
3.ผมเขียนตามcodeที่อาจาร์ยให้มา ขึ้น DONE ครับแต่ข้อมูลไม่มีเลย(งานจริงข้อมูลค่อนข้างมากครับ)
ช่วยตรวจสอบด้วยนะครับ
ขอบพระคุณครับ
อาร์ต

[snasui]

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

จาก Code Set rs = Range("A1:G" & .Range("A1048576").End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)

เปลี่ยนเป็น Set rs = .Range("A1:G" & .Range("A1048576").End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)

สังเกตว่ามีการเพิ่ม . หน้า Range ครับ

[lotto009]

ขอบคุณมากครับ