This code is not tested but I think will work. Let me know if there are
problems.

Sub Gettotals()

For Each sht In Sheets
If UCase(Right(sht.Name, 5)) = "TOTAL" Then
With sht
'get current column in row 5
Set c = .Rows(5).Find("Current", _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("could not find ""Current"" on sht : " & _
.Name & " row 5")
Else
'copy data to next column
LastRow = .Cells(5, c.Column).End(xlDown).Row
Set CopyRange = .Range(.Cells(5, c.Column), _
.Cells(LastRow, c.Column))
CopyRange.Copy Destination:=c.Offset(0, 1)
'Clear out word current
c.ClearContents

Row6Col = c.Column
'get current column in row 52
Set c = .Rows(52).Find("Current", _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("could not find ""Current"" on sht : " & _
.Name & " row 52")
Else
'copy data to row 6
LastRow = .Cells(52, c.Column).End(xlDown).Row
Set CopyRange = .Range(.Cells(53, c.Column), _
.Cells(LastRow, c.Column))
CopyRange.Copy
.Cells(6, Row6Col).PasteSpecial _
Paste:=xlPasteValues
'Remove formating
.Cells(52, c.Column).Copy
.Cells(52, c.Column).PasteSpecial _
Paste:=xlPasteValues
End If

'get current column in row 60
Set c = .Rows(60).Find("Current", _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("could not find ""Current"" on sht : " & _
.Name & " row 60")
Else
'copy data to first emty cell below row 5/6
LastRow = .Cells(60, c.Column).End(xlDown).Row
Set CopyRange = .Range(.Cells(61, c.Column), _
.Cells(LastRow, c.Column))
'find last row with data below row 5/6
LastRow = .Cells(5, Row6Col).End(xlDown).Row
CopyRange.Copy
.Cells(LastRow, Row6Col).PasteSpecial _
Paste:=xlPasteValues
'Remove formating
.Cells(60, c.Column).Copy
.Cells(60, c.Column).PasteSpecial _
Paste:=xlPasteValues
End If
End If
End With
End If
Next sht
End Sub


"MyKey" wrote:

All Help appreciated. Thanks so much for Helping
I have multiple sheets with information in them. In each Sheet named Total,
there is a column or columns heading named Current. For sheet with just one
"Current" that means I have one column but for those that are multiple with
Current (I merge the Columns and named them Current)
Every time I usually copy the columns or column and insert back on the
column(s) leaving me with same double information.

Can any one help me with the code that will copy all the column(s) with
heading Current and insert back across sheet without doing this manually. The
word Current is on row 5. Then delete the word Current on the old column and
leave it blank while the new column(s) created have Current. After then I
want to copy information in row 52 and row 60 under the word current and
paste as values in the old column(s). The WORD CURRENT is inside cell(s) that
is or are formatted, if the formatting can be removed from the old cells that
will be awesome.

E.g Before the code,
The Heading Current is on column 1 and 2 after merging the row with the
heading.
Sheet 1_Total
Col 1 Col 2
Current
1 20
2 4
3 2
4 45

Sheet 2_Total
Col 5
Current
50
30
2
6

After the code execution I want for Sheet1_Total
Current
1 20 1 20
2 4 2 4
3 2 3 2
4 45 4 45

For Sheet2_Total
Current
50 50
30 30
2 2
6 6

After then I want to copy information in row 52 and row 60 under the word
heading current and paste as values in the old column(s).

Thanks so much for your support.