Snasui Excel Forum

Code: Select all

Sub PasteData()
    Application.ScreenUpdating = False
    Sheets("Template").Range("B2:K2").Copy
    Sheets("Database").Range("A65536").End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues
    Sheets("Template").Range("C2:D2").Copy
    Sheets("Paid").Range("B" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Template").Range("G2").Copy
    Sheets("Paid").Range("D" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Template").Range("I2").Copy
    Sheets("Paid").Range("E" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Form").Range("C2,F2,H2:J2").ClearContents
    With Sheets("Form")
        .Range("B2") = .Range("B2") + 1
        .Range("B3") = .Range("B3") + 1
    End With
    Sheets("Paid").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _
        Sheets("Form").Range("B3")
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub PasteData()
    Application.ScreenUpdating = False
    Sheets("Sheet2").Range("A2:J2").Copy
    Sheets("Database").Range("A65536").End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues
    Sheets("Sheet2").Range("K2:O2").Copy
    Sheets("Paid").Range("A65536").End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues
    Sheets("Form").Range("C2,F2,H2:J2").ClearContents
    With Sheets("Form")
         .Range("B2") = .Range("B2") + 1
        .Range("B3") = .Range("B3") + 1
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub PasteData()
    Application.ScreenUpdating = False
    Sheets("Form").Range("A2:J2").Copy
    Sheets("Database").Range("A65536").End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues
    Sheets("Form").Range("B2:C2").Copy
    Sheets("Paid").Range("B" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Form").Range("F2").Copy
    Sheets("Paid").Range("D" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Form").Range("H2").Copy
    Sheets("Paid").Range("E" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Form").Range("C2,F2,H2:J2").ClearContents
    With Sheets("Form")
        .Range("B2") = .Range("B2") + 1
        .Range("B3") = .Range("B3") + 1
    End With
    Sheets("Paid").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _
        Sheets("Form").Range("B3")
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub PasteData()
Dim rSource As Range
Dim rTarget As Range
Set rSource = Worksheets("Form").Range("A2:J2")
Set rTarget = Worksheets("Database").Range("A65536").End(xlUp).Offset(1, 0)
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Set rSource = Worksheets("Form").Range("B2:C2")
    Set rTarget = Worksheets("Paid").Range("B" & Rows.Count).End(xlUp) _
    .Offset(1, 0)
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    Set rSource = Worksheets("Form").Range("F2")
    Set rTarget = Worksheets("Paid").Range("D" & Rows.Count).End(xlUp) _
        .Offset(1, 0)
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    Set rSource = Worksheets("Form").Range("H2")
    Set rTarget = Worksheets("Paid").Range("E" & Rows.Count).End(xlUp) _
        .Offset(1, 0)
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Sheets("Form").Range("C2,F2,H2:J2").ClearContents
    With Worksheets("Form")
        .Range("B2") = .Range("B2") + 1
    End With
    Application.ScreenUpdating = True
    With Worksheets("Form")
        .Range("B3") = .Range("B3") + 1
    End With
    Application.ScreenUpdating = True
End Sub

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Address = "$C$2" Or _
Target.Address = "$M$2") Then
    With ActiveSheet.Calendar1
    .Visible = True
    .Top = ActiveCell.Offset(0, 0).Top
    .Left = ActiveCell.Offset(0, 1).Left
    End With
Else
    ActiveSheet.Calendar1.Visible = False
End If
Application.EnableEvents = True
End Sub

Code: Select all

Sub SetPrintAreaBeforePrint()
Dim lng As Long
Dim r As Range
Dim i As Integer
On Error Resume Next
lng = Rows.Count
Set r = Sheets("Sheet2").Range("B3")
With Sheets("Database")
    i = Application.Match(r, .Range("B:B"), 0)
    If .Range("K" & i) = "Y" Then
        MsgBox "Your cheque alreay printed."
        Exit Sub
    End If
End With
Sheets("AY").Range("A1:M10").PrintOut
Sheets("Database").Range("K" & i) = "Y"
MsgBox "Finish."
End Sub