is there a way to combine these 3 macros into 1 macro ?

[s.schwantes]

the challenge seems to be referring back to the previously ActiveSheet . . . when toggling between CopyFrom range and Paste to range1, and PasteRange2 (two different copy to destinations).

thanks in advance for any ideas ...

Steve


Sub MacroRR1()
'
With ActiveSheet
If .Range("$B$14") = "No" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
Sheets("Rankin Report 1 - Summary").Select
Columns("E:F").Select
Selection.Insert Shift:=xlToRight
Range("E1:F76").Select
ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F1").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("F5").Select
Selection.ClearContents
Range("F8").Select
Selection.ClearContents
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End If
End With
End Sub

Sub Macro2()

With ActiveSheet
If .Range("$B$14") = "Yes" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
Sheets("Rankin Report 2 - Detail").Select
Columns("C:D").Select
Selection.Insert Shift:=xlToRight
Range("C1:D76").Select
ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("D5").Select
Selection.ClearContents
Range("D8").Select
Selection.ClearContents
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End If
End With

End Sub
Sub Macro3()
If Range("B14") = "No" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
Sheets("Rankin Report 2 - Detail").Select
Columns("C:D").Select
Selection.Insert Shift:=xlToRight
Range("C1:D76").Select
ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D1").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D5").Select
Selection.ClearContents
Range("D8").Select
Selection.ClearContents
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End If
End Sub
'

[Aussiebear]

Try this
ub MacroRR1()'
With ActiveSheet
If .Range("$B$14").Value = "No" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
With Sheets("Rankin Report 1 - Summary")
Columns("E:F").Insert Shift:=xlToRight
Range("E1:F76").Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F1", "F5", "F8").ClearContents
Application.CutCopyMode = False
Cells.EntireColumn.AutoFit
End With
With Sheets("Rankin Report s - Detail")
Columns("C:D").Insert Shift:=xlToRight
Range("C1:D76").Paste Link:=True
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D1", "D5", "D8").Clear Contents
Application.CutCopyMode = False
Cells.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
Else
If .Range("$B$14") = "Yes" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:="RR_Table_Copy"
.Copy

With Sheets("Rankin Report 2 - Detail")
Columns("C:D").Insert Shift:=xlToRight
Range("C1:D76").Paste Link:=True
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("D5", "D8").ClearContents
Cells.EntireColumn.AutoFit
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
End With
End Sub

I note that SamT has spoken to you about removing certain words from macro recorded code, namely .Select & Selection. When the macro recorder writes code it also writes the code in a way that slows down the operation of such code when it includes .Select & Selection. Good code very rarely if ever has it in. Thus you can shorten up code significantly.

Also when you need to repeat lines of code to work on different cells, it possible to combine the cells into an array, and do away with multiple line of extraneous code.

The problems I see here in combining these macros is that it may well effect those columns you needed to shift to the right. you will therefore need to check that the correct columns are intact being shifted to suit your reports

[Blade Hunter]

s.schwantes, this is the same code I posted on the other forum for you, I am just putting it here also for completeness :)



Sub MacroRR1()
Dim CurrSheet As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Range("$B$14") = "Yes" Or Range("$B$14") = "No" Then
CurrSheet = ActiveSheet
If Range("$B$14") = "No" Then
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
Sheets("Rankin Report 1 - Summary").Select
Columns("E:F").Insert Shift:=xlToRight
Range("E1:F76").Select
ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("F1,F5,F8").ClearContents
Cells.EntireColumn.AutoFit
End If
CurrSheet.Select
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
Sheets("Rankin Report 2 - Detail").Select
Columns("C:D").Insert Shift:=xlToRight
Range("C1:D76").Select
ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
If Range("B14") = "No" Then Range("D1").ClearContents
Range("D5,D8").ClearContents
Cells.EntireColumn.AutoFit
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[SamT]

Steve the WWW VBA expert helpers community is actually very small. Several of them roam around, and contribute to, all the sites

You are beginning to get the reputation of not even performing the most basic drudge work of formatting white space and removing extraneous Select-Selection pairs from your code.

That reputation will follow you. Guess what will eventually happen.

Look down below and see how many people have already read this.