Snasui Excel Forum

Code: Select all

Range("G1").Select
Selection.AutoFill Destination:=Range("G1:G" & Range("G1").CurrentRegion.Rows.Count), Type:=xlFillDefault

Code: Select all

Sub Macro6()
'
' Macro6 áÁâ¤Ã
'

'
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-4],0)"
    Range("G1").Select
    Columns("G:G").ColumnWidth = 12.13
    ActiveCell.FormulaR1C1 = "=IFERROR(RC[-4],0)"
    Range("G1").Select
    Selection.AutoFill Destination:=Range("G1:G15"), Type:=xlFillDefault
    Range("G1:G15").Select
    Range("H1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF((RC[-2]-RC[-3])<0,(RC[-2]-RC[-3])*-1,RC[-2]-RC[-3])"
    Range("H1").Select
    Selection.AutoFill Destination:=Range("H1:H15"), Type:=xlFillDefault
    Range("H1:H15").Select
End Sub

Code: Select all

Sub tesr()
   xx = DatePart("yyyy", Date)
   With Range("a:a")
        Set c = .Find(xx, LookIn:=xlValues)
        If Not c Is Nothing Then
              firstAddress = c.Address
              Do
                 i = i + 1
                 c.EntireRow.Copy Sheets("Sheet2").Cells(1 & i)
                 Set c = .FindNext(c)
              Loop While Not c Is Nothing And c.Address <> firstAddress
         End If
    End With
End Sub

Code: Select all

Sub tesr()
'xx = Worksheets("sheet1").Range("c5").Value
'Worksheets("sheet1").Range("c15").Value = xx
'i = WorksheetFunction.CountA(Worksheets("sheet1").Columns("C:C")) + 5
'Worksheets("sheet1").Cells(i, 3).Value = "Add data"
On Error Resume Next
    xx = DatePart("yyyy", Date)
    With Sheets("Sheet1").Range("a:a")
        Set c = .Find(What:=xx, After:=ActiveCell, _
            LookIn:=xlFormulas, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
            firstaddr = c.Address
            Do
                c.Value = ""
                Set c = Cells.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstaddr
        End If
    End With
    'Sheets("Sheet1").Range("a:a").SpecialCells( _
    '    xlCellTypeBlanks).EntireRow.Copy
    Sheets("Sheet1").Range("a:a").SpecialCells( _
       xlCellTypeBlanks).EntireRow.Copy
    Sheets("Sheet2").Select
    Rows("1:1").Select
    ActiveSheet.Paste
   
End Sub