Snasui Excel Forum

Code: Select all

Sub changeData_deberk()  'คลิกปรับปรุงข้อมูล  แก้ไขแล้วบันทึกซ้ำ
   If Range("g3") = "" Then Exit Sub
            If Sheets("DBberk").Columns("f:f").Find(Range("g3"), LookIn:=xlValues) Is Nothing Then
    Range("C4:g4").Select
    Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("DBberk").Cells(65536, "b").End(xlUp) _
            .Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
        'เรียงเสร็จเป็นช่องว่าง
  Worksheets("deberk").Range("c4:f503") = ""
   Application.CutCopyMode = False
    Sheets("deberk").Select
    Range("c4").Select
    MsgBox "ระบบจัดเก็บข้อมูลเรียบร้อยแล้ว", 38, "โปรแกรมรายงานเอกสารพัสดุ :                    "
            Else
            i = Sheets("DBberk").Columns("f:f").Find(Range("g4"), LookIn:=xlValues).Row
   Range("C4:g4").Select
    Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets("DBberk").Range("b" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Application.CutCopyMode = False
       'เป็นช่องว่าง
       
           Range("B4:F1048576").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.ClearContents
    Range("B4").Select
       
       
           Worksheets("deberk").Range("c4:f503") = ""
    Sheets("find_deberk").Select
    Range("b1").Select
    MsgBox "ระบบแก้ไขข้อมูลเรียบร้อยแล้ว", 38, "โปรแกรมรายงานเอกสารพัสดุ :                     "
    Dim iRet As Integer
    Dim strPrompt As String
    Dim strTitle As String
     ' Promt
    strPrompt = "พิมพ์เอกสารเลยหรือไม่ ?"
     ' Dialog's Title
    strTitle = "โปรแกรมรายงานเอกสารพัสดุ :                    "
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbYesNo, strTitle)
    ' Check pressed button
    If iRet = vbNo Then
    Else
        Sheets("pberk").Select
         Range("bc3").Select
        End If
End If
End Sub

Code: Select all

Sub changeData_deberk()  'คลิกปรับปรุงข้อมูล  แก้ไขแล้วบันทึกซ้ำ
    Dim target As Range
    With Sheets("DBberk")
        Set target = .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With
    If Range("g3") = "" Then Exit Sub
    If Sheets("DBberk").Columns("f:f").Find(Range("g3"), LookIn:=xlValues) Is Nothing Then
        Range("C4", Range("g" & Rows.Count).End(xlUp)).Select
        Selection.Copy
        target.PasteSpecial xlPasteValues
            'เรียงเสร็จเป็นช่องว่าง
        Worksheets("deberk").Range("c4:f503") = ""
        Application.CutCopyMode = False
        Sheets("deberk").Select
        Range("c4").Select
        MsgBox "ระบบจัดเก็บข้อมูลเรียบร้อยแล้ว", 38, "โปรแกรมรายงานเอกสารพัสดุ :                    "
    Else
        i = Sheets("DBberk").Columns("f:f").Find(Range("g4"), LookIn:=xlValues).Row
        Range("C4:g4").Select
        Range("C4", Range("g" & Rows.Count).End(xlUp)).Select
        Selection.Copy
        target.PasteSpecial xlPasteValues
'Other code
End Sub

Code: Select all

With Sheets("DBberk")
        Set target = .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With