move data in bold to a summary worksheet
 

I need the above to insert rows after cells D24 for the above of rows
it would require in order to paste the figures in.....

Copy from the data sheet to the summary sheet all the bold cells in
column C and then then offset to the left and copy the header for that
bold cell.

Copy both cells to the summary sheet by inserting rows in the summary
sheet after cell D24.

I hope this makes sense and someone could help me,

This is the macro I have so far......

Public Sub CopyRange()
Dim WB As Workbook
Dim srcSH As Worksheet
Dim destSH As Worksheet
Dim srcRng As Range
Dim rCell As Range
Dim copyRng As Range
Dim destRng As Range
Dim LRow As Long
Dim CalcMode As Long


Set WB = Workbooks("MyBook.xls") '<<=== CHANGE


With WB
Set srcSH = .Sheets("Sheet1") '<<=== CHANGE
Set destSH = .Sheets("Sheet2") '<<=== CHANGE
End With


Set srcRng = srcSH.Range("A1:A20") '<<==== CHANGE


With destSH
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set destRng = .Range("A" & LRow + 1)
End With


On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With


For Each rCell In srcRng.Cells
If rCell.Font.Bold = True Then
If copyRng Is Nothing Then
Set copyRng = rCell
Else
Set copyRng = _
Union(rCell, copyRng)
End If
End If
Next rCell


If Not copyRng Is Nothing Then
copyRng.EntireRow.Copy Destination:=destRng
End If


XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub


Thanks

Andrea

move data in bold to a summary worksheet
 

I wondered if someone could please help me adjust this macro attached
below to work on my data.

I posted this earlier this morning with no one being able to help.....

i'd be ever so grateful if someone could help adjust it,

Thanks so much,

Andrea

On 8 Jun, 11:08, "
wrote:
I need the above to insert rows after cells D24 for the above of rows
it would require in order to paste the figures in.....

Copy from the data sheet to the summary sheet all the bold cells in
column C and then then offset to the left and copy the header for that
bold cell.

Copy both cells to the summary sheet by inserting rows in the summary
sheet after cell D24.

I hope this makes sense and someone could help me,

This is the macro I have so far......

Public Sub CopyRange()
Dim WB As Workbook
Dim srcSH As Worksheet
Dim destSH As Worksheet
Dim srcRng As Range
Dim rCell As Range
Dim copyRng As Range
Dim destRng As Range
Dim LRow As Long
Dim CalcMode As Long

Set WB = Workbooks("MyBook.xls") '<<=== CHANGE

With WB
Set srcSH = .Sheets("Sheet1") '<<=== CHANGE
Set destSH = .Sheets("Sheet2") '<<=== CHANGE
End With

Set srcRng = srcSH.Range("A1:A20") '<<==== CHANGE

With destSH
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set destRng = .Range("A" & LRow + 1)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In srcRng.Cells
If rCell.Font.Bold = True Then
If copyRng Is Nothing Then
Set copyRng = rCell
Else
Set copyRng = _
Union(rCell, copyRng)
End If
End If
Next rCell

If Not copyRng Is Nothing Then
copyRng.EntireRow.Copy Destination:=destRng
End If

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub

Thanks

Andrea