Excel Forum

Code: Select all

Sub PasteData()
Dim rSource As Range
Dim rTarget As Range
Dim Lc As Integer, Ac As Integer
Dim FisYear As String
FisYear = InputBox("Please enter Year", "Year for UpdateStock")
    If FisYear = "" Then
        Exit Sub
    End If
    Range("A11:C60").Select
    Selection.ClearContents
Application.ScreenUpdating = True
Lc = Sheets("StockDay").Range("A65536").End(xlUp).Value + 1
With Worksheets("Report1")
    Ac = Application.CountIf(.Range("B:B"), Lc)
    Af = Application.Match(Lc, .Range("B:B"), 0)
End With
If Ac = 0 Then
    MsgBox "No data for paste."
       Exit Sub
End If
Set rSource = Sheets("Report1").Range( _
        "B" & Af & ":C" & Ac + Af - 1 & ",G" & Af & ":G" & Ac + Af - 1)
    Set rTarget = Sheets("StockDay").Range("A65536").End(xlUp).Offset(1, 0)
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    MsgBox "Record Complete"
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub EditOldStockDay()
Dim rs As Integer, i As Integer
Dim j As Integer, k As Integer
On Error Resume Next
rs = InputBox("Enter year for copy.")
i = Application.Match(rs, Worksheets("Report1") _
    .Range("B:B"), 0)
j = Application.CountIf(Worksheets("Report1") _
    .Range("B:B"), rs)
k = Application.Match(rs, Worksheets("StockDay") _
    .Range("A:A"), 0)
If j = 0 Then
    MsgBox "Year not found."
    Exit Sub
End If
Worksheets("Report1").Cells(i, 2).Resize(j).Copy
Worksheets("StockDay").Cells(k, 1).PasteSpecial xlPasteValues
Worksheets("Report1").Cells(i, 3).Resize(j).Copy
Worksheets("StockDay").Cells(k, 2).PasteSpecial xlPasteValues
Worksheets("Report1").Cells(i, 7).Resize(j).Copy
Worksheets("StockDay").Cells(k, 3).PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Finish."
End Sub