Snasui Excel Forum

Code: Select all

Workbooks.Open ("C:\Users\it-support.cmk\Desktop\àÅÕ¹ẺDBform\a.xlsx")
Dim myrange As Range
Set myrange = Range("A:G")
With Workbooks("b.xlsm").Worksheets(1)
lname = Application.VLookup(name, myrange, 2, False)
If IsError(lname) Then
MsgBox "äÁèÁÕ¢éÍÁÙÅ"
ActiveWorkbook.Close SaveChanges:=False 'ที่เพิ่มเข้าไปครับ
Exit Sub 'ที่เพิ่มเข้าไปครับ
Else

Code: Select all

With Workbooks("b.xlsm").Worksheets(1)
lname = Application.VLookup(name, myrange, 2, False)
If IsError(lname) Then
MsgBox "ไม่มีข้อมูล"
Else

Code: Select all

Sub lookup()
Dim name, lname, r, t, m, e, sg As Range
Set name = Range("C4")
Set lname = Range("E4")
Set r = Range("G4")
Set t = Range("C7")
Set m = Range("C8")
Set e = Range("C9")
Set sg = Range("E12")

Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\it-support.cmk\Desktop\àÅÕ¹ẺDBform\a.xlsx")
Dim myrange As Range
Set myrange = Range("A:G")
With Workbooks("b.xlsm").Worksheets(1)
If IsError(lname) Then       'เริ่มตรงนี้ครับ
MsgBox "äÁèÁÕ¢éÍÁÙÅ"
Else
lname = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 2, False), "")
r = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 3, False), "")
t = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 4, False), "")
m = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 5, False), "")
e = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 6, False), "")
sg = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 7, False), "")
End If
End With

ActiveWorkbook.Close SaveChanges:=False
End Sub

Code: Select all

 Range("A" & Rows.Count).End(xlUp).Offset(1) = name
 Range("A" & Rows.Count).End(xlUp).Offset(, 1) = lname
 Range("A" & Rows.Count).End(xlUp).Offset(, 2) = r
 Range("A" & Rows.Count).End(xlUp).Offset(, 3) = t
 Range("A" & Rows.Count).End(xlUp).Offset(, 4) = m
 Range("A" & Rows.Count).End(xlUp).Offset(, 5) = e
 Range("A" & Rows.Count).End(xlUp).Offset(, 6) = sg

Code: Select all

Sub save()
Dim name, lname, r, t, m, e, sg As Range
Set name = Range("C4")
Set lname = Range("E4")
Set r = Range("G4")
Set t = Range("C7")
Set m = Range("C8")
Set e = Range("C9")
Set sg = Range("E12")
Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\it-support.cmk\Desktop\เลียนแบบDBform\a.xlsx")
 Range("A" & Rows.Count).End(xlUp).Offset(1).Value = name.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 1).Value = lname.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 2).Value = r.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 3).Value = t.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 4).Value = m.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 5).Value = e.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 6).Value = sg.Value
 ActiveWorkbook.save
 ThisWorkbook.Activate
 Application.ScreenUpdating = True
End Sub

Code: Select all

Sub save()
Dim name, lname, r, t, m, e, sg As Range
Set name = Range("C4")
Set lname = Range("E4")
Set r = Range("G4")
Set t = Range("C7")
Set m = Range("C8")
Set e = Range("C9")
Set sg = Range("E12")

'ตั้งแต่ตรงนี้
Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\it-support.cmk\Desktop\àÅÕ¹ẺDBform\a.xlsx")
name.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
lname.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
r.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 2).PasteSpecial xlPasteValues
Application.CutCopyMode = False
t.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 3).PasteSpecial xlPasteValues
Application.CutCopyMode = False
m.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 4).PasteSpecial xlPasteValues
Application.CutCopyMode = False
e.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 5).PasteSpecial xlPasteValues
Application.CutCopyMode = False
sg.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 6).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'ถึงตรงนี้

Workbooks("a.xlsx").save
Workbooks("a.xlsx").Close


End Sub

Code: Select all

Range("A" & Row.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

Code: Select all

Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

Code: Select all

Application.CutCopyMode = fasle

Code: Select all

Application.CutCopyMode = False

Code: Select all

' Other code...
Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\it-support.cmk\Desktop\เลียนแบบDBform\a.xlsx")
name.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
' Other code...