ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่างครับ

[godman]

สวัสดีครับ
ผมติดปัญหาว่า พอดีว่า ผมอยากจะวางข้อมูลจากหน้าenter แต่ว่าข้อมูลมีการวางข้ามชี้ตมากกว่า 1 ชี้ต เช่นชี้ต SOP ชี้ต WI และชี้ตอื่นๆที่อาจจะมีเพ่ิม
ครานี้หน้าฟอร์มก็มีชนิดของข้อมูลหลายประเภทถ้าประเภทตรงกับชื่อชี้ตใหนก็จะถูกไปวางในชี้ตนั้น แต่โค้ดที่ผมมีรู้สึกว่ามันจะไป active ทุกชี้ตแล้วทำให้เซลล์กลายเป็นเข้าใจว่าไม่ว่าง พอจะสลับมาวางมันก็จะกระโดดข้ามแถวนั้นไปแถวอื่นเพราะเข้าใจว่าแถวไม่ว่างครับ ผมไม่แน่ใจว่าจะเกี่ยวกับเซลล์ที่มีสูตรหรือไม่
ไม่ทราบว่าผมต้องเปลี่ยนแปลงโค้ดที่จุดใหนครับ ผมแนบไฟล์มาให้ โดยที่sheet Enter ช่อง 14 จะเป็นตัวควบคุมว่าข้อมูลจะไปยัง sheet ใดเป็นของชี้ตใด

Code: Select all

Sub RecordNew()
Dim rs As Range, rt As Range
Dim rs1 As Range, rt1 As Range
Dim i As Integer
Worksheets("Enter").Range("M8") _
    = Application.Max(Worksheets("Master1") _
        .Range("Ao:Ao")) + 1
With Worksheets("Template1")
    i = Worksheets("Enter").Range("m6").Value
    Set rs = .Range(.Range("A2"), .Range("AO" & i + 1))
    Set rs1 = .Range("A6:O" & 6 + .Range("A4") - 1)
    Set rs2 = .Range("A10:O" & 10 + .Range("A4") - 1)
    
    
End With
    Set rt = Worksheets("Master1") _
        .Range("A65536").End(xlUp).Offset(1, 0)
     
    Set rt1 = Worksheets("SOP") _
        .Range("A65536").End(xlUp).Offset(1, 0)
    Set rt2 = Worksheets("WI") _
        .Range("A65536").End(xlUp).Offset(1, 0)
   
    rs.Copy
    rt.PasteSpecial xlPasteValues
    rs1.Copy
    rt1.PasteSpecial xlPasteValues
    rs2.Copy
    rt2.PasteSpecial xlPasteValues
   
    Application.CutCopyMode = False
MsgBox "Finish"
End Sub

[godman]

ผมลืมบอกไปว่า ผมตั้งคุณสมบัติเป็น table เพื่อต้องการให้สูตรมันขยับเอง เมื่อแถวเพิ่มมาใหม่ครับ

[tupthai]

เพิ่มการตรวจสอบว่าเราเลือกให้ไปเพิ่มข้อมูลชีทไหน

Code: Select all

 If [d14].Value = "SOP" Then
        rs1.Copy
        rt1.PasteSpecial xlPasteValues
    Else
        rs2.Copy
        rt2.PasteSpecial xlPasteValues
  End If

[godman]

ผมนำไปวางแล้ว ยังไม่ได้ครับ ยังคงกระโดดอยู่ครับ แต่ก็ขอบคุณคุณ tubthai มากครับ

[joo]

ต้องตัดโค๊ดบรรทัดนี้ออกไปก่อนครับ
Other..
rs.Copy
rt.PasteSpecial xlPasteValues
rs1.Copy
rt1.PasteSpecial xlPasteValues
rs2.Copy
rt2.PasteSpecial xlPasteValues

[godman]

ใช้ได้ดีเลยครับ สุดยอดมากครับ ทั้งสองท่าน ขอบคุณมาก

[godman]

สวัสดีครับ
ต้องขอบอกว่าที่ท่านผู้รู้ได้ตอบผมไป ผมได้นำไปต่อยอดแล้ว แต่ว่ามีความต้องการเพิ่มว่า ถ้าข้อมูลจากเซลล์ D6 ที่เป็นชื่อประเภทถ้าเป็นประเภทเดียวกันซึ่งได้จากการดูในช่อง B:B ของแต่ละชี้ต
ก็ให้วางแทนที่ ทั้งแถว เสมือนหนึ่งการวางแบบแก้ไขข้อมูลที่มีลักษณะบางอย่างเป็นตัวตั้งในที่นี้ผมใช้รหัสเอกสารหรืก Document Number เป็นตัวหลักในการแก้ไขข้อมูลแล้วเขียนโค้ดว่าถ้าคอลัมพ์ b:b มีชื่อตรงกันก็ให้นำข้อมูลใน template ไปวางแทนทั้งแถวครับ
แต่ผมได้ลองปรับโค้ดแล้วแต่ยัง error อยู่ครับ การ error จะเกี่ยวกับ else if ที่ผมยังไม่คล่องเขียน VB หรือปล่าวครับ ผมได้ส่งไฟล์มาตอนที่เขียนว่ายัง error อยู่ อยู่ชี้ตหลักคือ ชี้ต enter

Code: Select all

Sub RecordNew()
Dim rs As Range, rt As Range
Dim rs1 As Range, rt1 As Range
Dim i As Integer
Worksheets("Enter").Range("M8") _
    = Application.Max(Worksheets("Master1") _
        .Range("Ao:Ao")) + 1
With Worksheets("Template1")
    i = Worksheets("Enter").Range("m6").Value
    Set rs = .Range(.Range("A2"), .Range("AO" & i + 1))
    Set rs1 = .Range("A6:O" & 6 + .Range("A4") - 1)
    Set rs2 = .Range("A10:O" & 10 + .Range("A4") - 1)
    
    
End With
    Set rt = Worksheets("Master1") _
        .Range("A65536").End(xlUp).Offset(1, 0)
     
    Set rt1 = Worksheets("SOP") _
        .Range("A65536").End(xlUp).Offset(1, 0)
    Set rt2 = Worksheets("WI") _
        .Range("A65536").End(xlUp).Offset(1, 0)
   
    
   
    Application.CutCopyMode = False
  
 If [d14].Value = "SOP" Then
        rs1.Copy
        rt1.PasteSpecial xlPasteValues
         Else
          Dim lng As Long
          lng = Application.Match(Sheets("BOM").Range("d6"), _
            Sheets("SOP").Range("b:b"), 0)
    Else
        rs2.Copy
        rt2.PasteSpecial xlPasteValues
        Else
          Dim lng As Long
          lng = Application.Match(Sheets("BOM").Range("d6"), _
            Sheets("WI").Range("b:b"), 0)
  End If

   
MsgBox "Finish"
End Sub

[godman]

โทษครับผมลืมแก้โค้ดชื่อชี้ต ตอนนี้แก้ไขแล้วครับ แต่ยัง error อยู่

Code: Select all

Sub RecordNew()
Dim rs As Range, rt As Range
Dim rs1 As Range, rt1 As Range
Dim i As Integer
Worksheets("Enter").Range("M8") _
    = Application.Max(Worksheets("Master1") _
        .Range("Ao:Ao")) + 1
With Worksheets("Template1")
    i = Worksheets("Enter").Range("m6").Value
    Set rs = .Range(.Range("A2"), .Range("AO" & i + 1))
    Set rs1 = .Range("A6:O" & 6 + .Range("A4") - 1)
    Set rs2 = .Range("A10:O" & 10 + .Range("A4") - 1)
    
    
End With
    Set rt = Worksheets("Master1") _
        .Range("A65536").End(xlUp).Offset(1, 0)
     
    Set rt1 = Worksheets("SOP") _
        .Range("A65536").End(xlUp).Offset(1, 0)
    Set rt2 = Worksheets("WI") _
        .Range("A65536").End(xlUp).Offset(1, 0)
   
    
   
    Application.CutCopyMode = False
  
 If [d14].Value = "SOP" Then
        rs1.Copy
        rt1.PasteSpecial xlPasteValues
         Else
          Dim lng As Long
          lng = Application.Match(Sheets("SOP").Range("d6"), _
            Sheets("SOP").Range("b:b"), 0)
    Else
        rs2.Copy
        rt2.PasteSpecial xlPasteValues
        Else
          Dim lng As Long
          lng = Application.Match(Sheets("WI").Range("d6"), _
            Sheets("WI").Range("b:b"), 0)
  End If

   
MsgBox "Finish"
End Sub

[tupthai]

ผิดหลักไวยากรณ์ การใช้ if else elseif
ดูตาม link นี้ครับ
http://www.techonthenet.com/excel/formulas/if_then.php

[godman]

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

[godman]

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

[tupthai]

ลองดูครับว่าใช้ได้หรือเปล่า

Code: Select all

Sub RecordNew()
Dim rs As Range, rt As Range
Dim rs1 As Range, rt1 As Range
Dim i As Integer
Worksheets("Enter").Range("M8") _
    = Application.Max(Worksheets("Master1") _
        .Range("Ao:Ao")) + 1
With Worksheets("Template1")
    i = Worksheets("Enter").Range("m6").Value
    Set rs = .Range(.Range("A2"), .Range("AO" & i + 1))
    Set rs1 = .Range("A6:O" & 6 + .Range("A4") - 1)
    Set rs2 = .Range("A10:O" & 10 + .Range("A4") - 1)
    
    
End With
    Set rt = Worksheets("Master1") _
        .Range("A65536").End(xlUp).Offset(1, 0)
     
    Set rt1 = Worksheets("SOP") _
        .Range("A65536").End(xlUp).Offset(1, 0)
    Set rt2 = Worksheets("WI") _
        .Range("A65536").End(xlUp).Offset(1, 0)
   
 If [d14].Value = "SOP" Then
     Set rt1 = Sheets("SOP").Cells(Application.Match(Sheets("SOP").Range("d6"), Sheets("SOP").Range("b:b"), 0), 1)
        rs1.Copy
        rt1.PasteSpecial xlPasteValues
    Else
       Set rt2 = Sheets("WI").Cells(Application.Match(Sheets("SOP").Range("d6"), Sheets("SOP").Range("b:b"), 0), 1)
        rs2.Copy
        rt2.PasteSpecial xlPasteValues
  End If
  Application.CutCopyMode = False
MsgBox "Finish"
End Sub

[godman]

ขอบคุณมากครับ ใช้งานได้ดีเลยแหละ สุดยอดมาก