Martin_H
Board Regular
- Joined
- Aug 26, 2020
- Messages
- 190
- Office Version
- 365
- Platform
- Windows
Hi,
would it be possible to combine all the code below into a one macro?
Thank you for help.
would it be possible to combine all the code below into a one macro?
Thank you for help.
VBA Code:
Sub Copy_One()
Dim WS As Worksheet
Dim r As Range
Dim i As Long
i = 1
For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "SAP" And WS.Name <> "PLAN" And WS.Name <> "SUM" And WS.Name <> "TACHO" Then
Worksheets("TACHO").Range("J" & i & ":J" & i).Value = WS.Range("T128").Value
i = i + 1
End If
Next WS
End Sub
Sub Copy_Two()
Dim WS As Worksheet
Dim r As Range
Dim i As Long
i = 1
For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "SAP" And WS.Name <> "PLAN" And WS.Name <> "SUM" And WS.Name <> "TACHO" Then
Worksheets("TACHO").Range("M" & i & ":M" & i).Value = WS.Range("AO128").Value
i = i + 1
End If
Next WS
End Sub
Sub Copy_Three()
Dim WS As Worksheet
Dim r As Range
Dim i As Long
i = 1
For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "SAP" And WS.Name <> "PLAN" And WS.Name <> "SUM" And WS.Name <> "TACHO" Then
Worksheets("TACHO").Range("N" & i & ":N" & i).Value = WS.Range("AZ128").Value
i = i + 1
End If
Next WS
End Sub
Sub Copy_Four()
Dim WS As Worksheet
Dim r As Range
Dim i As Long
i = 1
For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "SAP" And WS.Name <> "PLAN" And WS.Name <> "SUM" And WS.Name <> "TACHO" Then
Worksheets("TACHO").Range("K" & i & ":K" & i).Value = WS.Range("AL128").Value
i = i + 1
End If
Next WS
End Sub
Sub Copy_Five()
Dim WS As Worksheet
Dim r As Range
Dim i As Long
i = 1
For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "SAP" And WS.Name <> "PLAN" And WS.Name <> "SUM" And WS.Name <> "TACHO" Then
Worksheets("TACHO").Range("i" & i & ":i" & i).Value = WS.Range("B2").Value
i = i + 1
End If
Next WS
End Sub