Results 1 to 1 of 1

Copy/paste formatting

Threaded View

BBoydAnchor Copy/paste formatting 01-05-2012, 04:34 PM
  1. #1
    Registered User
    Join Date
    12-15-2011
    Location
    Charleston, SC
    MS-Off Ver
    Excel 2010
    Posts
    43

    Smile Copy/paste formatting

    Below is code that nilem supplied a week ago and I have added a couple of lines to delete some conditional formatting and it works as needed, but not I'm stumped with needing to copy/paste some formatting. The code that I have tried is red below.

    Will someone help me with this? This is the last piece of the puzzle for what I've been working on.

    Sub SumCells()
    
        ActiveSheet.Outline.ShowLevels RowLevels:=2
    
        Dim r As Range, i As Long, adr As String
        For Each r In Range("B5:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(2).Areas
            i = r.Row + r.Count
            Cells(i, 6).Formula = "=SUM(" & r.Offset(, 4).Address(0, 0) & ")"
            Cells(i, 9).Formula = "=SUM(" & r.Offset(, 7).Address(0, 0) & ")"
            Cells(i, 11).FormatConditions.Delete
            Cells(i, 12).FormatConditions.Delete
            Cells(i + 1, 11).Resize(, 2).Clear
            adr = adr & "," & Cells(i, 6).Address(0, 0)
        Next r
        With Cells(i + 2, 6)
            .Formula = "=SUM(" & Mid(adr, 2) & ")"
            .Copy .Offset(, 3)
    '''''''''''''''''''''''''''''''''    .Copy .Offset(2, 0).PasteSpecial Paste:=xlPasteFormats <-- NEED TO COPY FORMATTING from 2 cells above
        End With
    End Sub
    It took some time, but I solved this problem myself. The solution is...

    Sub SumCells()
    
        ActiveSheet.Outline.ShowLevels RowLevels:=2
    
        Dim r As Range, i As Long, adr As String
        For Each r In Range("B5:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(2).Areas
            i = r.Row + r.Count
            Cells(i, 6).Formula = "=SUM(" & r.Offset(, 4).Address(0, 0) & ")"
            Cells(i, 9).Formula = "=SUM(" & r.Offset(, 7).Address(0, 0) & ")"
            Cells(i, 11).FormatConditions.Delete
            Cells(i, 12).FormatConditions.Delete
            Cells(i + 1, 11).Resize(, 2).Clear
            adr = adr & "," & Cells(i, 6).Address(0, 0)
        Next r
        With Cells(i + 2, 6)
            .Formula = "=SUM(" & Mid(adr, 2) & ")"
            .Font.Name = "Tahoma"
            .Font.Size = 8
            .Copy .Offset(, 3)
        End With
    End Sub
    Usually someone answers very quickly when I post a question here, but maybe I've asked too much.
    Last edited by BBoydAnchor; 01-05-2012 at 09:26 PM. Reason: Provide a solution

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1