Snasui Excel Forum

Code: Select all

Sub Paste()
    Dim irRange As Variant
    Dim i As Integer, rw As Long
    irRange = Array("B9", "B10", "B11", _
        "B12", "B13", "B15", "B16", _
        "B17", "B18", "B19", "B20", "B21", _
        "B22", "B23", "B24", "B25", "B26")
    rw = Worksheets("Database").Range("b" & Rows.Count).End(xlUp).Row + 1
    For i = 0 To UBound(irRange)
        With Worksheets("Database")
            .Range("b" & rw).Offset(0, i).Value = Sheets("Input").Range(irRange(i)).Value
        End With
    ActiveWorkbook.Worksheets("Database").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Database").Sort.SortFields.Add Key:=Range("D3:D3") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Database").Sort
        .SetRange Range("A3:R1000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Next i
End Sub

Code: Select all

.SetRange Range("A3:R1000")

Code: Select all

Sub Paste()
    Dim irRange As Variant
    Dim i As Integer, rw As Long
    irRange = Array("B9", "B10", "B11", _
        "B12", "B13", "B15", "B16", _
        "B17", "B18", "B19", "B20", "B21", _
        "B22", "B23", "B24", "B25", "B26")
      Sheets("Database").Select
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("Input").Select
    rw = Worksheets("Database").Range("B3").Row
    For i = 0 To UBound(irRange)
        With Worksheets("Database")
            .Range("b" & rw).Offset(0, i).Value = Sheets("Input").Range(irRange(i)).Value
        End With
    Next i
End Sub