Snasui Excel Forum

Code: Select all

Sub PasteData()
Dim rSource As Range
Dim rTarget As Range
With Worksheets("Sheet1")
    Set rSource = .Range("A2:F2").Resize(.Range("G1"))
End With
Set rTarget = Worksheets("Sheet2").Range("A1000").End(xlUp).Offset(1, 0)
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

Code: Select all

Sub Macro1()
Dim rSource As Range
Dim rTarget As Range
With Worksheets("Sheet1")
    Set rSource = .Range("A2:F2").Resize(.Range("G1"))
End With
Set rTarget = Worksheets("Sheet2").Range("A1000").End(xlUp).Offset(1, 0)
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDash
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDash
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDash
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDash
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDash
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDash
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End Sub

Code: Select all

Sub Macro2()
Dim rSource As Range
Dim rTarget As Range
With Worksheets("Sheet1")
    Set rSource = .Range("A2:F2").Resize(.Range("G1"))
End With
Set rTarget = Worksheets("Sheet2").Range("A1000").End(xlUp).Offset(1, 0)
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

Code: Select all

Sub PasteData()
    Call Macro1
End Sub

Code: Select all

Sub PasteData()
    With Sheets("Sheet2")
        If .ColorIndex = xlAutomatic = True Then
            Call Macro2
        Else
            Call Macro1
                .ColorIndex = 0
        End If
    End With
    Application.EnableEvents = True
End Sub

Code: Select all

Sub PasteData()
    Dim clr1 As Double
    Dim clr2 As Double
    With Worksheets("Sheet2")
        clr1 = .Range("A1000").End(xlUp).Interior.Color
        clr2 = .Range("G1").Interior.Color
        If clr1 - clr2 = 0 Then
            Call Macro1
        Else
            Call Macro2
        End If
    End With
End Sub