Snasui Excel Forum

Code: Select all

Private Sub CommandButton1_Click()

    Range("B2:H2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Record").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Sheets("Cal").Select
    Application.CutCopyMode = False
End Sub

Code: Select all

Range("A2").Select

Code: Select all

Selection.PasteSpecial Paste:=xlPasteValues

Code: Select all

Private Sub ClearData_Click()
    Dim stgChoose As Integer
    Dim rngCount As Range
    Dim rngCstCode As Range
    Set rngCount = Sheets("record").Range("A2:EJ2")
    Set rngCstCode = Sheets("record").Range("A4:EJ800")
    
    stgChoose = MsgBox("คุณแน่ใจหรือว่าจะลบข้อมูลในชีท Record", vbOKCancel + 64)
    
    If stgChoose = 1 Then
        rngCount.ClearContents
        rngCstCode.ClearContents
    End If
    MsgBox "ล้างข้อมูลในชีท 'Record' เรียบร้อยแล้ว"
End Sub

Code: Select all

...
Application.Calculation = xlCalculationManual
If stgChoose = 1 Then
     rngCount.ClearContents
     rngCstCode.ClearContents
End If
Application.Calculation = xlCalculationAutomatic
...

Code: Select all

Private Sub Send_Data_Click()
    Dim rngData As Range
    Dim intChoose As Integer
    Set rngData = Sheets("1Collect").Range("A3:M200")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    intChoose = MsgBox("ทำการส่งข้อมูลไปที่แผ่นงาน Final", vbOKCancel + vbInformation)
    
    If intChoose = 1 Then
        rngData.Select
        Selection.Copy
        Sheets("Final").Select
            ActiveSheet.Unprotect
            ActiveSheet.Range("A1048576").Select
            Selection.End(xlUp).Offset(1, 0).Select
            Selection.PasteSpecial xlPasteValues
            ActiveSheet.Range("B2").Select
            ActiveSheet.Protect AllowFiltering:=True
        Sheets("1Collect").Select
            ActiveSheet.Range("P1").Select
    End If
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "ส่งข้อมูลเรียบร้อย"
 
End Sub

Code: Select all

Selection.PasteSpecial xlPasteValues

Code: Select all

Private Sub Send_Data_Click()
    Dim rngData As Range
    Dim intChoose As Integer
    Dim iCount As Integer
    
    iCount = Application.CountIf(Sheets("1Collect").Range("a3:a1000"), "?*")
    Set rngData = Sheets("1Collect").Range("A3:M" & iCount)
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    intChoose = MsgBox("ทำการส่งข้อมูลไปที่แผ่นงาน Final", vbOKCancel + vbInformation)
    
    If intChoose = 1 Then
        Sheets("Final").Select
        ActiveSheet.Unprotect
        rngData.Copy
        ActiveSheet.Range("A1048576").Select
        Selection.End(xlUp).Offset(1, 0).Select
        Selection.PasteSpecial xlPasteValues
        ActiveSheet.Range("B2").Select
        ActiveSheet.Protect AllowFiltering:=True
        Sheets("1Collect").Select
        ActiveSheet.Range("P1").Select
    End If
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "ส่งข้อมูลเรียบร้อย"
 
End Sub