CODEWITHSUNDEEP
vbaexcel
mesakon
mesakon

Reputation: 39

VBA- Copy specific cells to new added data

Here is the code that I am using to add data to specific columns. I would like to be able to loop through a range in the sheet, and copy the entire border style of range of (A1:C1) to new added data.

Private Sub Add_Click()


Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim n As Long



n = sh.Range("A" & Application.Rows.Count).End(xlUp).Row

sh.Range("A" & n + 1).Value = Me.Id.Value
sh.Range("B" & n + 1).Value = Me.Title.Value
sh.Range("C" & n + 1).Value = Me.Sev.Value

Upvotes: 0

Views: 60

Answers (2)

chris neilsen
chris neilsen

Reputation: 53137

It seems the OP didn't ask for what they actually wanted, and was satisfied with an answer that copies all format, not just borders. For the sake of future readers, here's a method that copies just borders.

Private Sub CopyBorders(rSrc As Range, rDst As Range)
    Dim BorderIndex As Long
    Dim i As Long
    If rSrc.Cells.Count <> rDst.Cells.Count Then Exit Sub
    For i = 1 To rSrc.Cells.Count
        For BorderIndex = 5 To 12
            ApplyBorder rSrc.Cells(i), rDst.Cells(i), BorderIndex
        Next
    Next
End Sub

Private Sub ApplyBorder(rSrc As Range, rDst As Range, BorderIndex As Long)
    Dim Bdr As Border
    Set Bdr = rSrc.Borders(BorderIndex)
    With rDst.Borders(BorderIndex)
        .LineStyle = Bdr.LineStyle
        If .LineStyle <> xlNone Then
            .Color = Bdr.Color
            .TintAndShade = Bdr.TintAndShade
            .Weight = Bdr.Weight
        End If
    End With
End Sub

Op would call it like this

sh.Range("A" & n + 1).Value = Me.Id.Value
sh.Range("B" & n + 1).Value = Me.Title.Value
sh.Range("C" & n + 1).Value = Me.Sev.Value

'Copy Borders
CopyBorders sh.Range("A1:C1"), sh.Range("A" & n+1 & ":C" & n+1)

Upvotes: 0

Pᴇʜ
Pᴇʜ

Reputation: 57683

you can just copy the range

sh.Range("A1:C1").Copy

and paste formats

sh.Range("A" & n+1 & ":C" & n+1).PasteSpecial Paste:=xlPasteFormats

Upvotes: 1

Related Questions