CopyFormat

Applies format into a cell (or range) from another cell.
Can apply from any cell, range, sheet or open workbook into any cell, range, sheet, or open workbook.
Any parameter is missing (except cell addresses) are assumed to be active sheet, or this workbook
Formats copied here are, number formats, hidden formula, all alignments, locked, font (foreground), interior (background), all borders except diagonal. For some reason it is not copied

Sub CopyFormat(FromCellAddr, ToCellAddr, _
 Optional FromWk = "This", Optional FromShee = "This", _
 Optional ToWk = "This", Optional ToShee = "This")
 If ToWk = "This" Then ToWk = ThisWorkbook.Name
 If ToShee = "This" Then ToShee = Workbooks(ToWk).ActiveSheet.Name
 If FromWk = "This" Then FromWk = ThisWorkbook.Name
 If FromShee = "This" Then FromShee = Workbooks(FromWk).ActiveSheet.Name
 ' general
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).NumberFormat = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).NumberFormat
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Locked = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Locked
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).FormulaHidden = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).FormulaHidden
 ' interiors (background)
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Interior.Pattern = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Interior.Pattern
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Interior.PatternColorIndex = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Interior.PatternColorIndex
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Interior.Color = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Interior.Color
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Interior.TintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Interior.TintAndShade
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Interior.PatternTintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Interior.PatternTintAndShade
 ' font (foreground)
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Bold = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Bold
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Italic = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Italic
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Name = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Name
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.FontStyle = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.FontStyle
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Size = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Size
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Strikethrough = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Strikethrough
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Superscript = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Superscript
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Subscript = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Subscript
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.OutlineFont = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.OutlineFont
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Shadow = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Shadow
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Underline = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Underline
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.Color = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.Color
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.TintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.TintAndShade
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Font.ThemeFont = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Font.ThemeFont
 ' alignments
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).HorizontalAlignment = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).HorizontalAlignment
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).VerticalAlignment = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).VerticalAlignment
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).WrapText = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).WrapText
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Orientation = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Orientation
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).AddIndent = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).AddIndent
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).IndentLevel = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).IndentLevel
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).ShrinkToFit = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).ShrinkToFit
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).ReadingOrder = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).ReadingOrder
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).MergeCells = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).MergeCells
 ' borders, all
' Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlDiagonalDown).LineStyle = _
'  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlDiagonalDown).LineStyle
' Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlDiagonalDown).Color = _
'  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlDiagonalDown).Color
' Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlDiagonalDown).TintAndShade = _
'  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlDiagonalDown).TintAndShade
' Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlDiagonalDown).Weight = _
'  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlDiagonalDown).Weight
'
' Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlDiagonalUp).LineStyle = _
'  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlDiagonalUp).LineStyle
' Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlDiagonalUp).Color = _
'  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlDiagonalUp).Color
' Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlDiagonalUp).TintAndShade = _
'  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlDiagonalUp).TintAndShade
' Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlDiagonalUp).Weight = _
'  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlDiagonalUp).Weight
  
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeLeft).LineStyle = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeLeft).LineStyle
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeLeft).Color = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeLeft).Color
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeLeft).TintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeLeft).TintAndShade
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeLeft).Weight = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeLeft).Weight
  
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeTop).LineStyle = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeTop).LineStyle
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeTop).Color = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeTop).Color
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeTop).TintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeTop).TintAndShade
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeTop).Weight = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeTop).Weight

 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeBottom).LineStyle = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeBottom).LineStyle
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeBottom).Color = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeBottom).Color
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeBottom).TintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeBottom).TintAndShade
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeBottom).Weight = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeBottom).Weight
  
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeRight).LineStyle = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeRight).LineStyle
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeRight).Color = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeRight).Color
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeRight).TintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeRight).TintAndShade
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlEdgeRight).Weight = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlEdgeRight).Weight
  
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlInsideVertical).LineStyle = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlInsideVertical).LineStyle
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlInsideVertical).Color = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlInsideVertical).Color
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlInsideVertical).TintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlInsideVertical).TintAndShade
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlInsideVertical).Weight = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlInsideVertical).Weight
  
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlInsideHorizontal).LineStyle = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlInsideHorizontal).LineStyle
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlInsideHorizontal).Color = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlInsideHorizontal).Color
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlInsideHorizontal).TintAndShade = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlInsideHorizontal).TintAndShade
 Workbooks(ToWk).Worksheets(ToShee).Range(ToCellAddr).Borders(xlInsideHorizontal).Weight = _
  Workbooks(FromWk).Worksheets(FromShee).Range(FromCellAddr).Borders(xlInsideHorizontal).Weight
 ' more ???
End Sub

FromCellAddr, ToCellAddr, Optional FromWk, Optional FromShee, Optional ToWk, Optional ToShee

Views 699 Downloads 319

'cell', 'format', 'alignments', 'borders', 'font', 'background', 'foreground', 'color', 'font family', 'style', 'copy'

ANmarAmdeen
333
Graphics VBA-Excel
Revisions

v1.0