help adapting recorded macro.

[coxycoxycoxy]

Hi All

Have record a piece of code using the macro recorder, that copies a range of cells in a worksheet, and then pastes links to those cells in another worksheet.

would some one please be kind enough to show me how to adapt the code so that is does the same for every work sheet in the work book.

Sheets
   ("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("B9").Select
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("B8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("E3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("C8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("O3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("G8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("Q5:R5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("I8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("S5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("K8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("Q6:R6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("Q8:R8").Select
    ActiveSheet.Paste Link:=True
    Range("I20").Select
End Sub

Thanks in advance

Mark

 

[John Davis]

Hi All

Have record a piece of code using the macro recorder, that copies a range of cells in a worksheet, and then pastes links to those cells in another worksheet.

would some one please be kind enough to show me how to adapt the code so that is does the same for every work sheet in the work book.

Sheets
   ("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("B9").Select
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("B8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("E3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("C8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("O3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("G8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("Q5:R5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("I8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("S5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("K8").Select
    ActiveSheet.Paste Link:=True
    Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Select
    Range("Q6:R6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CONTROL.SHEET").Select
    Range("Q8:R8").Select
    ActiveSheet.Paste Link:=True
    Range("I20").Select
End Sub

Thanks in advance

Mark

Maybe this will give you some ideas:

Sub coxycoxycoxy()
Application.ScreenUpdating = False
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets


If ws.Name <> "SH 0.25X457X305MM ALLOY 42 HH " Then

Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Range("B9").Copy
ws.Select
Range("B8").Select
ActiveSheet.Paste Link:=True
Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Range("E3").Copy
ws.Select
Range("C8").Select
ActiveSheet.Paste Link:=True
Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Range("O3").Copy
ws.Select
Range("G8").Select
ActiveSheet.Paste Link:=True
Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Range("Q5:R5").Copy
ws.Select
Range("I8").Select
ActiveSheet.Paste Link:=True
Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Range("S5").Copy
ws.Select
Range("K8").Select
ActiveSheet.Paste Link:=True
Sheets("SH 0.25X457X305MM ALLOY 42 HH ").Range("Q6:R6").Copy
ws.Select
Range("Q8:R8").Select
ActiveSheet.Paste Link:=True

End If

Next ws

Application.ScreenUpdating = True

End Sub