Snasui Excel Forum

Code: Select all

Sub Paste()
    Dim irRange As Range
    Worksheets("sheet1").Range("c4:c8").Copy
    Worksheets("sheet1").Cells(65536, "B").End(xlUp) _
            .Offset(1, 0).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("c4").Select
    With Worksheets("sheet1")
        Set irRange = .Range("b16", .Range("f" & Rows.Count).End(xlUp))
        irRange.Borders.LineStyle = xlContinuous
        irRange.Sort Key1:=.Range("b16"), Order1:=xlAscending, Header:=xlGuess
    End With
End Sub

Code: Select all

dim lngRowNum As Long
lngRowNum = WorksheetFunction.COUNTIF(ช่วงกลุ่มเซลล์,เซลล์ที่รับค่ารหัส)

Code: Select all

dim lngPosition As Long
lngPosition = WorksheetFunction.MATCH(เซลล์ที่รับค่ารหัส,ช่วงกลุ่มเซลล์,0)

Code: Select all

Sub Paste()
    Dim irRange As Range
    Dim lngRowNum As Long
    Dim lngPosition As Long
   With Application
    lngRowNum = WorksheetFunction.CountIf(Range("b16:b65536"), Range("c4")).End(xlUp).Row
    lngPosition = WorksheetFunction.Match(Range("C4") & Range("B16:B65536"), 0).End(xlUp).Row
    Worksheets("sheet1").Range("c4:c8").Copy
    Worksheets("sheet1").Cells(65536, "B").End(xlUp) _
            .Offset(Range("b16"), lngPosition, lngRowNum, 0, 1, 5).PasteSpecial xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Range("c4").Select
    With Worksheets("sheet1")
        Set irRange = .Range("b16", .Range("f" & Rows.Count).End(xlUp))
        irRange.Borders.LineStyle = xlContinuous
        irRange.Sort Key1:=.Range("b16"), Order1:=xlAscending, Header:=xlGuess
    End With
End Sub

Code: Select all

Sub Paste()
    Dim irRange As Range
    Dim lngRowNum As Long
    Dim lngPosition As Long
   With Application
    lngRowNum = WorksheetFunction.CountIf(Range("b16:b" & Range("B65536").End(xlUp).Row), Range("c4"))
    If lngRowNum = 0 Then
     Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
    Else
    lngRowNum = WorksheetFunction.Match(Range("C4"), Range("B16:B" & Range("B65536").End(xlUp).Row), 0)
    Range("B" & (15 + lngRowNum)).PasteSpecial xlPasteValues, Transpose:=True
    End If
    Range("c4").Select
    With Worksheets("sheet1")
        Set irRange = .Range("b16", .Range("f" & Rows.Count).End(xlUp))
        irRange.Borders.LineStyle = xlContinuous
        irRange.Sort Key1:=.Range("b16"), Order1:=xlAscending, Header:=xlGuess
    End With
End Sub

Code: Select all

Sub PasteData()
    Dim irRange As Range
    Dim lngRowNum As Long
    Dim lngPosition As Long
    With Application
        lngRowNum = .WorksheetFunction.CountIf(Range("b16:b" & Range("B65536").End(xlUp).Row), Range("c4"))
        If lngRowNum = 0 Then
            Range("c4:c8").Copy
            Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
        Else
            lngPosition = .WorksheetFunction.Match(Range("c4"), Range("b16:b" & Range("b" & Rows.Count).End(xlUp).Row), 0)
            Range("c4:c8").Copy
            Range("B" & (15 + lngPosition)).PasteSpecial xlPasteValues, Transpose:=True
        End If
        With Worksheets("sheet1")
            Set irRange = .Range("b16", .Range("f" & Rows.Count).End(xlUp))
            irRange.Borders.LineStyle = xlContinuous
            irRange.Sort Key1:=.Range("b16"), Order1:=xlAscending, Header:=xlGuess
        End With
    End With
End Sub

Code: Select all

Sub PasteData()
    Dim irRange As Range
    Dim lngRowNum As Long
    Dim lngPosition As Long
    Dim lr As Long
    With Application
        lngRowNum = .WorksheetFunction.CountIf(Range("b16:b" & Range("B65536").End(xlUp).Row), Range("c4"))
        If lngRowNum = 0 Then
            Range("c4:c8").Copy
            Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
        Else
            lngPosition = .WorksheetFunction.Match(Range("c4"), Range("b16:b" & Range("b" & Rows.Count).End(xlUp).Row), 0)
            Range("c4:c8").Copy
            Range("B" & (15 + lngPosition)).PasteSpecial xlPasteValues, Transpose:=True
        End If
        With Worksheets("sheet1")
            lr = Range("B" & Rows.Count).End(xlUp).Row
            Set irRange = .Range("b16:f" & lr)
            irRange.Borders.LineStyle = xlContinuous
            irRange.Sort Key1:=.Range("b16"), Order1:=xlAscending, Header:=xlGuess
        End With
    End With
End Sub