ต้องการSort data โดยใช้ marco

[March201711]

ต้องการ sort data ที่ขึ้นต้นด้วย 490xxx copy มาไว้ที่ sheet Main ใช้ record marco แล้วไม่ยืดหยุ่น ต้องปรับยังงัยคะ

Code: Select all

 Sub update()
'

'
    Sheets("Data").Select
    ActiveWindow.SmallScroll Down:=-27
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$H$60").AutoFilter Field:=1, Criteria1:=Array( _
        "490407", "490435", "490477", "490485", "490513", "490601", "490604", "490606", _
        "490610", "490613", "490617", "490620", "490621", "490624", "490707", "490730", _
        "490742", "490743"), Operator:=xlFilterValues
    Range("A21").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Main").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("A3").Select
    ActiveSheet.Paste
    Range("C6").Select
    Sheets("Data").Select
    ActiveWindow.SmallScroll Down:=-27
    Range("C21").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B33").Select
    ActiveWindow.SmallScroll Down:=-21
    Sheets("Main").Select
    Range("C3").Select
    ActiveSheet.Paste
    Range("L8").Select
End Sub
 

[snasui]

ตัวอย่างการปรับ Code ให้เลือกเฉพาะที่ขึ้นต้นด้วย 490 ครับ

Code: Select all

'Other code
ActiveSheet.Range("$A$1:$H$60").AutoFilter Field:=1, Criteria1:="490*"
'Other code

[March201711]

ได้แล้วค่ะ ขอถามอีกนิดนึงค่ะ
ถ้าจะเอาข้อมูลจาก sheet Main Cell A3 copy มาต่อช้อมูลจาก sheet Detail เป็นการเก็บข้อมูลวันที่ 21/1/22 (High light สีเหลือง)ในแต่ละวัน ถ้าวันถัดมาเป็นวันที่ 22/1/22 ต้องมาต่อที่ sheet Detail cell A54: H54 ต้องปรับสูตรยังไงให้มีความยึดหยุ่นคะ

Code: Select all

 Sub KeepData()
'

'
    Sheets("Main").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Detail").Select
    ActiveWindow.SmallScroll Down:=3
    Range("A20").Select
    Selection.End(xlDown).Select
    ActiveWindow.SmallScroll Down:=9
    Range("A35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C35").Select
    Sheets("Main").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G17").Select
    Sheets("Detail").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J32").Select
    ActiveWindow.SmallScroll Down:=-30
    Range("K3").Select
End Sub
 

[snasui]

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

Code: Select all

Sub KeepData()
'

'
    Sheets("Main").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Detail").Select
'    ActiveWindow.SmallScroll Down:=3
'    Range("A20").Select
'    Selection.End(xlDown).Select
'    ActiveWindow.SmallScroll Down:=9
'    Range("A35").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'    Range("C35").Select
    Selection.Offset(0, 2).Select
    Sheets("Main").Select
'    ActiveWindow.SmallScroll Down:=-9
    Range("C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
'    Application.CutCopyMode = False
    Selection.Copy
'    Range("G17").Select
    Sheets("Detail").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J32").Select
'    ActiveWindow.SmallScroll Down:=-30
    Application.CutCopyMode = False
    Range("K3").Select
End Sub

[March201711]

ได้ข้อมูลตามที่ต้องการ แต่มีปัญหานิดนึงค่ะ
คือ sort ข้อมูล "490*", ได้แล้ว ถ้าต้อง sort data เพิ่ม "036300", "036600" พอปรับแล้ว run data มา showแค่ ยอด 036600 เองค่ะ ต้องปรับยังไงคะ

Code: Select all

 Sub update()
'

'
    Sheets("Data").Select
    ActiveWindow.SmallScroll Down:=-27
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
'    ActiveSheet.Range("$A$1:$H$60").AutoFilter Field:=1, Criteria1:=Array( _
'        "490407", "490435", "490477", "490485", "490513", "490601", "490604", "490606", _
'        "490610", "490613", "490617", "490620", "490621", "490624", "490707", "490730", _
'        "490742", "490743"), Operator:=xlFilterValues

    ActiveSheet.Range("$A$1:$H$60").AutoFilter field:=1, Criteria1:="490*"
    ActiveSheet.Range("$A$1:$H$60").AutoFilter field:=1, Criteria1:="036300*"
    ActiveSheet.Range("$A$1:$H$60").AutoFilter field:=1, Criteria1:="036600*"
    Range("A21").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Main").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("A3").Select
    ActiveSheet.Paste
    Range("C6").Select
    Sheets("Data").Select
    ActiveWindow.SmallScroll Down:=-27
    Range("C21").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B33").Select
    ActiveWindow.SmallScroll Down:=-21
    Sheets("Main").Select
    Range("C3").Select
    ActiveSheet.Paste
    Range("L8").Select
End Sub

[snasui]

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

Code: Select all

'Other code
ActiveSheet.Range("$A$1:$H$60").AutoFilter Field:=1, Criteria1:=Array("490*", "036*"), _
    Operator:=xlFilterValues
'Other code

[March201711]

ได้แล้วค่ะ ขอบคุณมากค่ะอาจารย์