Code วางเรียงตามอักษรค่ะ
Posted: Wed Feb 08, 2017 8:52 pm
เรียนอาจารย์และท่านผู้รู้ช่วยปรับโค้ดค่ะ
ตัวอย่างไฟล์ Form.xlsm ชีท Form เซลล์ B5 ดึงค่าสุดท้ายจากชีท Alphabetize อักษรตามในเซลล์ A5 ไปวางไฟล์ CusID_Share.xlsx ชีท Sheet1 คอลัมน์ B เรียงต่อท้ายตามอักษรค่ะ
โค้ดติด
ฟ้องตามรูปแนบค่ะ
ตัวอย่างไฟล์ Form.xlsm ชีท Form เซลล์ B5 ดึงค่าสุดท้ายจากชีท Alphabetize อักษรตามในเซลล์ A5 ไปวางไฟล์ CusID_Share.xlsx ชีท Sheet1 คอลัมน์ B เรียงต่อท้ายตามอักษรค่ะ
โค้ดติด
E = .Sheets("Sheet1").Range("b" & Rows.Count).End(xlUp).Value + 1 นี้ค่ะ ฟ้องตามรูปแนบค่ะ
Code: Select all
Sub PasteData()
Dim wbShare As Workbook
Dim formBook As Workbook
Dim rTarget As Range
Dim E As Long
Dim rs As Range
Dim rt As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("CusID_Share.xlsx")
With wbShare
E = .Sheets("Sheet1").Range("b" & Rows.Count).End(xlUp).Value + 1
Select Case formBook.Sheets("Form").Range("a5").Value
Case "ก"
E = formBook.Sheets("Alphabetize").Range("c2")
Case "ข"
E = formBook.Sheets("Alphabetize").Range("c3")
Case "ค"
E = formBook.Sheets("Alphabetize").Range("c4")
End Select
formBook.Worksheets("Form").Range("b5").Value = E
End With
wbShare.Save
With formBook.Worksheets("Form")
Set rs = .Range("A5:C5")
End With
Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
rs.Copy: rt.PasteSpecial xlPasteValues
formBook.Activate
End Sub