Snasui Excel Forum

Code: Select all

Sub Save»éÒ¢ÒÂʴ˹éÒÃéÒ¹()
' Save»éÒ¢ÒÂʴ˹éÒÃéÒ¹ Macro
With SheetDatabase
    If .Range("D13") = "" Then
        MsgBox "Your data not complete. Please verify and try again."
        Exit Sub
    End If
End With
A = MsgBox("µéͧ¡Òúѹ·Ö¡", vbCritical + vbYesNo)
If A = vbYes Then
    For i = 1 To 1
    Application.Goto Reference:="msrec»éÒ¢ÒÂʴ˹éÒÃéÒ¹"
    Selection.Copy
    Application.Goto Reference:="uldt»éÒ¢ÒÂʴ˹éÒÃéÒ¹"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Home").Select
    Range("B5").Select
    Selection.ClearContents
    Next i
    End If
End Sub

Code: Select all

Sub SaveBlue()
' SaveBlue Macro
        With Sheets("Database")
            If .Range("D13").Value = "" Then
                MsgBox "Your data not complete. Please verify and try again."
                Exit Sub
            End If
        End With
        A = MsgBox("Are you sure?", vbCritical + vbYesNo)
        If A = vbYes Then
            Application.Goto Reference:="msrecBlue"
            Selection.Copy
            Application.Goto Reference:="uldtBlue"
            ActiveSheet.Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Application.CutCopyMode = False
            Sheets("Home").Select
            Range("B5").Select
            Selection.ClearContents
        End If
End Sub

Code: Select all

Sub ChooseBlueReccord()
'
' Macro1 Macro
    Dim r As Range, rBlue As Range
    With ActiveSheet
        Set rBlue = .Range("dtblue")
        For Each r In rBlue
            If Len(r.Value) < 1 Then r.Clear
        Next r
        Set rBlue = .Range("dtblue").SpecialCells(xlCellTypeConstants)
    End With
    rBlue.Select
End Sub