Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/

ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

https://www.snasui.com/viewtopic.php?t=4079

Page 1 of 1

ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Mon Jan 21, 2013 5:45 pm
by natthaporn
ดิฉันได้เขียน code สำหรับส่งข้อมูลจาก sheet "send" ไปยัง sheet "CEN",
NUM" และ "EDP" ดังนี้คะ

Code: Select all

Private Sub SendData_Click()

    If ActiveSheet.Range("E2") = "CEN" Then
    Range("B4:K4").Select
    Selection.AutoFilter
    ActiveSheet.Range("B4:K50").AutoFilter Field:=1, Criteria1:="c"
    End If
    
    If ActiveSheet.Range("E2") = "NUM" Then
    Range("B4:K4").Select
    Selection.AutoFilter
    ActiveSheet.Range("B4:K50").AutoFilter Field:=1, Criteria1:="n"
    End If
    
    If ActiveSheet.Range("E2") = "EDP" Then
    Range("B4:K4").Select
    Selection.AutoFilter
    ActiveSheet.Range("B4:K50").AutoFilter Field:=1, Criteria1:="e"
    End If
    
    Application.Goto Reference:="Source1"
    Selection.Copy
    Application.Goto Reference:="Target1"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="Source1"
    
    Application.Goto Reference:="Source2"
    Selection.Copy
    Application.Goto Reference:="Target2"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="Source2"
    
    Application.Goto Reference:="Source3"
    Selection.Copy
    Application.Goto Reference:="Target3"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="Source3"
    
    Application.Goto Reference:="Source4"
    Selection.Copy
    Application.Goto Reference:="Target4"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="Source4"
    
    ActiveSheet.Range("B4:K50").AutoFilter Field:=1
    Selection.AutoFilter
    Range("D2").Select
   
End Sub
ดิฉํนรบกวนสอบถามผู้รู้เกี่ยวกับการเขียน code เพิ่มเติมดังนี้คะ
1. ดิฉันต้องการให้ข้อมูลของชุดถัดไปที่อยู่ใน sheet"send" ไปต่อท้ายข้อมูลเดิม
โดยให้มีเงื่อนไขว่าต้องดูจาก column "B" ของ sheet "CEN",
NUM" และ "EDP" เป็นหลัก คือ ถ้ามีข้อมูลอยู่ที่ colum "B" ให้ข้อมูลชุดถัดไป ต่อท้ายไปเรื่อย ๆ
ซึ่งข้อมูลใน sheet "CEN", NUM" และ "EDP" นอกจากจะถูกส่งไปจาก sheet "send" แล้ว
อาจจะต้องมีการ key in เข้าไปโดยตรง

ขอบคุณคะ

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Mon Jan 21, 2013 7:28 pm
by snasui
:D ลองตามนี้ครับ
  1. ปรับ Range Name เป็นตามด้านล่าง ตัวอื่น ๆ คงเดิม
    1. Target1 =OFFSET(INDIRECT(send!$E$2&"!"&"$B$5"),COUNTA(INDIRECT(send!$E$2&"!"&"B:B")),0)
    2. Target2 =OFFSET(INDIRECT(send!$E$2&"!"&"$F$5"),COUNTA(INDIRECT(send!$E$2&"!"&"B:B")),0)
    3. Target3 =OFFSET(INDIRECT(send!$E$2&"!"&"$J$5"),COUNTA(INDIRECT(send!$E$2&"!"&"B:B")),0)
    4. Target4 =OFFSET(INDIRECT(send!$E$2&"!"&"$N$5"),COUNTA(INDIRECT(send!$E$2&"!"&"B:B")),0)
  2. ปรับ Code เป็นตามด้านล่าง สังเกตการลำดับ Code ว่าเรียงใหม่อย่างไร

    Code: Select all

    Private Sub SendData_Click()

    If ActiveSheet.Range("E2") = "CEN" Then
    Range("B4:K4").Select
    Selection.AutoFilter
    ActiveSheet.Range("B4:K50").AutoFilter Field:=1, Criteria1:="c"
    End If
    
    If ActiveSheet.Range("E2") = "NUM" Then
    Range("B4:K4").Select
    Selection.AutoFilter
    ActiveSheet.Range("B4:K50").AutoFilter Field:=1, Criteria1:="n"
    End If
    
    If ActiveSheet.Range("E2") = "EDP" Then
    Range("B4:K4").Select
    Selection.AutoFilter
    ActiveSheet.Range("B4:K50").AutoFilter Field:=1, Criteria1:="e"
    End If
    
    
    Application.Goto Reference:="Source2"
    Selection.Copy
    Application.Goto Reference:="Target2"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="Source2"
    
    Application.Goto Reference:="Source3"
    Selection.Copy
    Application.Goto Reference:="Target3"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="Source3"
    
    Application.Goto Reference:="Source4"
    Selection.Copy
    Application.Goto Reference:="Target4"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="Source4"
    
    Application.Goto Reference:="Source1"
    Selection.Copy
    Application.Goto Reference:="Target1"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="Source1"

    
    ActiveSheet.Range("B4:K50").AutoFilter Field:=1
    Selection.AutoFilter
    Range("D2").Select
   
End Sub

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Mon Jan 21, 2013 11:53 pm
by natthaporn
สูตรและ code ที่อาจารย์ที่แนะนำมา สามารถ run ข้อมูลได้ตามที่ต้องการแล้วคะ เหคุผลที่อาจารย์นำ Target1 มาไว้ run เป็นอันดับสุดท้ายดิฉันเข้าใจว่าเป็นเพราะที่ Source มีข้อมูลของ column B ทุก row เนื่องจากข้อมูลที่ส่งเข้ามาใหม่นั้นจะต้องต่อท้ายข้อมูลที่อยู่ใน column B
ดิฉันมีเรื่องรบกวนถามอาจารย์อีกอย่างหนึ่งคือ เมื่อดิฉันนำ code ดังกล่าวนี้ไปใช้กับ file จริง ข้อมูลที่ปรากฎอยู่ใน Target ทำไมจึงอยู่ที่ row ที่ B8 กล่าวคือ ข้อมูลขยับลงมาอึก 2 row ส่วนข้อมูลชุดต่อไปที่ส่งเข้ามาใหม่ต่อท้ายข้อมูลชุดเดิม ไม่มีปัญหาอะไร
ทั้ง ๆ ที่ file ตัวอย่างและ file จริง Target อยุ๋ที่เดียวกัน คือ B6 ทั้งนี้ดิฉันไม่สามารถที่จะส่ง file จริงให้อาจารย์ดูได้คะ สูตรที่ใช้คือดังนี้คะ

1. Target1 =OFFSET(INDIRECT(Data-TPA!$E$2&"!"&"$B$5"),COUNTA(INDIRECT(Data-TPA!$E$2&"!"&"B:B")),0)
2. Target2 =OFFSET(INDIRECT(Data-TPA!$E$2&"!"&"$I$5"),COUNTA(INDIRECT(Data-TPA!$E$2&"!"&"B:B")),0)
3. Target3 =OFFSET(INDIRECT(Data-TPA!$E$2&"!"&"$T$5"),COUNTA(INDIRECT(Data-TPA!$E$2&"!"&"B:B")),0)
4. Target4 =OFFSET(INDIRECT(Data-TPA!$E$2&"!"&"$AE$5"),COUNTA(INDIRECT(Data-TPA!$E$2&"!"&"B:B")),0)
5. Target5 =OFFSET(INDIRECT(Data-TPA!$E$2&"!"&"$AP$5"),COUNTA(INDIRECT(Data-TPA!$E$2&"!"&"B:B")),0)

รบกวนอาจารย์ช่วยแนะนำด้วยคะ หรือถ้าอาจารย์ต้องการข้อมูลอะไรเพี่มเติม สามารถบอกมาได้เลยคะ

ขอบคุณมากคะ

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Tue Jan 22, 2013 8:30 am
by snasui
:D กรณีเป็นไฟล์จริงให้เปลี่ยนข้อมูลสำคัญไปเป็นอย่างอื่นแล้วแนบไฟล์นั้นมาครับ จะได้สะดวกในการตอบมากกว่าไม่เห็นไฟล์ครับ

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Tue Jan 22, 2013 12:50 pm
by natthaporn
ดิฉันได้ส่ง file มาให้ใหม่แล้วคะ ปัญหาที่พบมีดังนี้คือ
1. เมื่อส่งข้อมูลมาที่ sheet ที่เป็น target ข้อมูลจะมาอยู่ที่ B8 ซึ่งจริง ๆ แล้วควรจะอยู่ที่ B6
2. ที่ sheet Data-TPA เมื่อเลือก "North" ที่ cell E2 เมื่อ click "Send" แล้วทำไมข้อมูลทั้งหมดถูกส่งมาที่ sheet "North" ในขณะที่ไม่มีข้อมูลของ "North" เลย ดิฉันลอง debug แล้วเลือก run เฉพาะช่วงการ filter แล้ว ซึ่งการทำ filter ก็ถูกต้องแต่ทำไม่ข้อมูลที่ส่งไปจึงไม่ถูกต้องคะ

ขอบคุณคะ

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Tue Jan 22, 2013 2:02 pm
by snasui
:D ปรับ Range Name ให้อ้างอิงบรรทัดที่ 3 แทน ยกตัวอย่างเช่น

=OFFSET(INDIRECT('Data-TPA'!$E$2&"!"&"$I$3"),COUNTA(INDIRECT('Data-TPA'!$E$2&"!"&"B:B")),0)

และปรับ Code ให้ตรวจสอบว่าพบรหัสที่ต้องการหรือไม่ หากไม่พบให้ออกจาก Procedure ไม่ต้องดำเนินการต่อ ตัวอย่างตามด้านล่างครับ

Code: Select all

'Other code
If ActiveSheet.Range("TPARegion") = "NORTH" Then
    If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "n") = 0 Then
        MsgBox "Can't found ""NORTH"" in your data."
        Exit Sub
    End If
Else
    Range("TPAFilter").Select
    Selection.AutoFilter
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=n", _
    Operator:=xlAnd
End If

'Other code

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Tue Jan 22, 2013 3:13 pm
by natthaporn
ได้ผลลัพธ์ตามที่ต้องการแล้วคะ ขอขอบคุณมาก ๆ สำหรับคำแนะนำคะ

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Tue Jan 22, 2013 11:19 pm
by natthaporn
อาจารย์คิ ดิฉันได้ทำข้อมูลต่อยอดมาถึง sheet "TOTAL" ซึ่งต้อง copy ข้อมูลมาจาก sheet "CENTRAL-R","NORTH-R", .... โดยดิฉันได้เขียน code ดังนี้คะ

Code: Select all

Private Sub CopyData_Click()
ActiveSheet.Range("TOTAL").Select
Selection.ClearContents

    Application.Goto Reference:="CENTRALR"
    Selection.Copy
    Application.Goto Reference:="TGC"
    Selection.PasteSpecial Paste:=xlPasteValues
    
    Application.Goto Reference:="NORTHR"
    Selection.Copy '
    Application.Goto Reference:="TGN" (debug)
    Selection.PasteSpecial Paste:=xlPasteValues
    
   Application.Goto Reference:="NORTHEASTR"
    Selection.Copy
    Application.Goto Reference:="TGNE"
    Selection.PasteSpecial Paste:=xlPasteValues
    
    Application.Goto Reference:="EASTR"
    Selection.Copy
    Application.Goto Reference:="TGE"
    Selection.PasteSpecial Paste:=xlPasteValues
    
    Application.Goto Reference:="SOUTHR"
    Selection.Copy
    Application.Goto Reference:="TGS" (debug)
    Selection.PasteSpecial Paste:=xlPasteValues
   
    Application.CutCopyMode = False
End Sub
ซึ่ง code ดังกล่าวนี้ จะติด debug อยู่ 2 จุด โดยจุด 2 จุด ดังกล่าวเป็น sheet ที่ไม่มีข้อมูลคะ
ดิฉันจึงอยากจะขอรบกวนอาจารย์ช่วยแนะนำด้วยคะ

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Tue Jan 22, 2013 11:32 pm
by snasui
:D ลองใช้

Code: Select all

On Error Resume Next
เข้ามาช่วยโดยวางไว้บรรทัดบนก่อน Statement อื่น ๆ ครับ

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Wed Jan 23, 2013 10:18 am
by natthaporn
อาจารย์เคยเขียนคำสั่งนี้วางไว้หน้า statement ของ code ที่อาจารย์เคยแนะนำมาก่อนหน้านี้ และเมื่อคืนดิฉันก็ทดลองใช้แล้ว พอตรวจสอบข้อมูลที่วิ่งมาดิฉันเห็นว่าข้อมูลมาไม่ครบก็เลยคิดว่า คำสั่งนี้ใช้ไม่ได้
ตอนนี้ดิฉันลองใช้คำสั่งนี้อีกที่ ปรากฎว่าข้อมูลถูกต้องครบถ้วนคะ แสดงว่าเมื่อคืนคงตาลายไปหน่อยคะ

ต้องขอขอบคุณอาจารย์เป็นอย่างมากอึกครั้งคะ

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Wed Jan 23, 2013 12:38 pm
by natthaporn
ก่อนอื่นดิฉนต้องขอโทษด้วยที่รบกวนอาจารย์บ่อยมากเลยคะ ดิฉันมีประเด็นเกิดขึ้นอีกแล้วคะ พยายามแก้ code และหาสาเหตุตั้งแต่เช้าแล้วแต่ก็หาไม่พบ ประเด็นมีดังนี้คะ
ที่ sheet "Data-TPA" เมื่อเลือก "CENTRAL","NORTHEAST","EAST" ที่ cell E2 ข้อมูลที่ส่งมาที่ sheet ต่างๆ เหล่านี้ เป็นข้อมูลชุดเดียวกัน คือเป็นข้อมูลของ "SOUTH" แต่พอเลือก "SOUTH" ข้อมูลที่ปรากฎที่ sheet "SOUTH" กลายเป็นข้อมูลของ "EAST"

ดิฉันขอรบกวนอาจารย์ชี้แนะด้วยคะ code มีดังนี้คะ

Code: Select all

Private Sub RecordTPA_Click()
   'ActiveSheet.Range("STPAValue").Select
    'Selection.ClearContents
    
     Range("TPASort").Select
    ActiveWorkbook.Worksheets("Data-TPA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Data-TPA").Sort.SortFields.Add Key:=Range( _
        "TTPASection"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Data-TPA").Sort
        .SetRange Range("TPASort")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveSheet.Range("TTPA7") = "=TPARegion2"
    ActiveSheet.Range("TTPA1") = "=TPATRIM1"
    ActiveSheet.Range("TTPA3") = "=TPARevSection"
    ActiveSheet.Range("TTPA2") = "=TPAVLOOKUP1"
    ActiveSheet.Range("TTPA5") = "=TPAVLOOKUP2"
    ActiveSheet.Range("TTPA6") = "=TPATRIM2"

    ActiveSheet.Range("TTPA3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
        
    ActiveSheet.Range("STPAValue").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

     If ActiveSheet.Range("TPARegion") = "CENTRAL" Then
    If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "c") = 0 Then
    MsgBox "Can't found ""CENTRAL"" in your data."
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1
    Selection.AutoFilter
    Exit Sub
    End If
    Else
    Range("TPAFilter").Select
    Selection.AutoFilter
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=c", _
    Operator:=xlAnd
    End If

    If ActiveSheet.Range("TPARegion") = "NORTH" Then
    If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "n") = 0 Then
    MsgBox "Can't found ""NORTH"" in your data."
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1
    Selection.AutoFilter
    Exit Sub
    End If
    Else
    Range("TPAFilter").Select
    Selection.AutoFilter
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=n", _
    Operator:=xlAnd
    End If

    If ActiveSheet.Range("TPARegion") = "NORTHEAST" Then
    If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "ne") = 0 Then
    MsgBox "Can't found ""NORTHEAST"" in your data."
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1
    Selection.AutoFilter
    Exit Sub
    End If
    Else
    Range("TPAFilter").Select
    Selection.AutoFilter
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=ne", _
    Operator:=xlAnd
    End If

    If ActiveSheet.Range("TPARegion") = "EAST" Then
    If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "e") = 0 Then
    MsgBox "Can't found ""EAST"" in your data."
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1
    Selection.AutoFilter
    Exit Sub
    End If
    Else
    Range("TPAFilter").Select
    Selection.AutoFilter
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=e", _
    Operator:=xlAnd
    End If

    If ActiveSheet.Range("TPARegion") = "SOUTH" Then
    If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "s") = 0 Then
    MsgBox "Can't found ""SOUTH"" in your data."
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1
    Selection.AutoFilter
    Exit Sub
    End If
    Else
    Range("TPAFilter").Select
    Selection.AutoFilter
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=s", _
    Operator:=xlAnd
    End If

    
   Application.Goto Reference:="STPAAC"
    Selection.Copy
    Application.Goto Reference:="TTPAAC"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPAAC"
    
    Application.Goto Reference:="STPAAE"
    Selection.Copy
    Application.Goto Reference:="TTPAAE"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPAAE"
    
    Application.Goto Reference:="STPACB"
    Selection.Copy
    Application.Goto Reference:="TTPACB"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPACB"
    
    Application.Goto Reference:="STPAPMA"
    Selection.Copy
    Application.Goto Reference:="TTPAPMA"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPAPMA"
    
    Application.Goto Reference:="STPADT"
    Selection.Copy
    Application.Goto Reference:="TTPADT"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPADT"
    
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1
    Selection.AutoFilter
    Range("D2").Select
    Application.ScreenUpdating = True

End Sub

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Wed Jan 23, 2013 1:26 pm
by snasui
:D ดูตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Private Sub RecordTPA_Click()
    'ActiveSheet.Range("STPAValue").Select
    'Selection.ClearContents
    
    Range("TPASort").Select
    ActiveWorkbook.Worksheets("Data-TPA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Data-TPA").Sort.SortFields.Add Key:=Range( _
        "TTPASection"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Data-TPA").Sort
        .SetRange Range("TPASort")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveSheet.Range("TTPA7") = "=TPARegion2"
    ActiveSheet.Range("TTPA1") = "=TPATRIM1"
    ActiveSheet.Range("TTPA3") = "=TPARevSection"
    ActiveSheet.Range("TTPA2") = "=TPAVLOOKUP1"
    ActiveSheet.Range("TTPA5") = "=TPAVLOOKUP2"
    ActiveSheet.Range("TTPA6") = "=TPATRIM2"
    
    On Error Resume Next '1. Add this line
    ActiveSheet.ShowAllData '2. Add this line
    ActiveSheet.Range("TTPA3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
        
    ActiveSheet.Range("STPAValue").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    '3. Correctness "If statement"
    If ActiveSheet.Range("TPARegion") = "CENTRAL" Then
        If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "c") = 0 Then
            MsgBox "Can't found ""CENTRAL"" in your data."
            Exit Sub
        Else
            Range("TPAFilter").Select
            Selection.AutoFilter
            ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=c", _
            Operator:=xlAnd
        End If
    End If

    If ActiveSheet.Range("TPARegion") = "NORTH" Then
        If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "n") = 0 Then
            MsgBox "Can't found ""NORTH"" in your data."
            Exit Sub
        Else
            Range("TPAFilter").Select
            Selection.AutoFilter
            ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=n", _
            Operator:=xlAnd
        End If
    End If

    If ActiveSheet.Range("TPARegion") = "NORTHEAST" Then
        If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "ne") = 0 Then
            MsgBox "Can't found ""NORTHEAST"" in your data."
            Exit Sub
        Else
            Range("TPAFilter").Select
            Selection.AutoFilter
            ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=ne", _
            Operator:=xlAnd
        End If
    End If

    If ActiveSheet.Range("TPARegion") = "EAST" Then
        If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "e") = 0 Then
            MsgBox "Can't found ""EAST"" in your data."
            Exit Sub
        Else
            Range("TPAFilter").Select
            Selection.AutoFilter
            ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=e", _
            Operator:=xlAnd
        End If
    End If

    If ActiveSheet.Range("TPARegion") = "SOUTH" Then
        If Application.CountIf(Sheets("Data-TPA").Range("B:B"), "s") = 0 Then
            MsgBox "Can't found ""SOUTH"" in your data."
            Exit Sub
        Else
            Range("TPAFilter").Select
            Selection.AutoFilter
            ActiveSheet.Range("STPAFilter").AutoFilter Field:=1, Criteria1:="=s", _
            Operator:=xlAnd
        End If
    End If
    
   Application.Goto Reference:="STPAAC"
    Selection.Copy
    Application.Goto Reference:="TTPAAC"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPAAC"
    
    Application.Goto Reference:="STPAAE"
    Selection.Copy
    Application.Goto Reference:="TTPAAE"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPAAE"
    
    Application.Goto Reference:="STPACB"
    Selection.Copy
    Application.Goto Reference:="TTPACB"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPACB"
    
    Application.Goto Reference:="STPAPMA"
    Selection.Copy
    Application.Goto Reference:="TTPAPMA"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPAPMA"
    
    Application.Goto Reference:="STPADT"
    Selection.Copy
    Application.Goto Reference:="TTPADT"
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Goto Reference:="STPADT"
    
    ActiveSheet.Range("STPAFilter").AutoFilter Field:=1
    Selection.AutoFilter
    Range("D2").Select
    Application.ScreenUpdating = True

End Sub

Re: ขอสอบถาม Code VBA ในการส่งข้อมูลไปยัง sheet อื่น

Posted: Wed Jan 23, 2013 2:47 pm
by natthaporn
ได้ผลลัพธ์ตามที่ต้องการแล้วคะ ต้องขอขอบคุณอาจารย์มากคะ อาจารย์ให้คำแนะนำที่มีประโยชน์ ทำให้ดิฉันเข้าใจมากขึ้นว่าถ้า code เกิดปัญหา จะต้องปรับอย่างไร และดิฉันคิดว่าผู้ที่เข้ามาสอบถามปัญหาคงจะมีความเห็นแบบเดียวกันกับดิฉัน
ขอบคุณมากคะ
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited