Hi
I have number of sheets with some data. In all of them there is a sequence
of data starting:"Summary by Customer Category" and it ends :"TOTAL
STATEMENT".
It can be found in column A.
How I can copy this data from all of sheets and paste it into master sheet?

--
Greatly appreciated
Eva

Data Filter Auto Filter

Custom

Items Begin With...Summary by Customer Category
And
Items End with...TOTAL

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Eva" wrote:

Hi
I have number of sheets with some data. In all of them there is a sequence
of data starting:"Summary by Customer Category" and it ends :"TOTAL
STATEMENT".
It can be found in column A.
How I can copy this data from all of sheets and paste it into master sheet?

--
Greatly appreciated
Eva

Hi
Thank you for your response, but it is not exactly what I want. There are
about 20 sheets and I was thinking about the macro, that copy the same
section in all sheets and paste it into master sheet.
--
Greatly appreciated
Eva


"ryguy7272" wrote:

Data Filter Auto Filter

Custom

Items Begin With...Summary by Customer Category
And
Items End with...TOTAL

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Eva" wrote:

Hi
I have number of sheets with some data. In all of them there is a sequence
of data starting:"Summary by Customer Category" and it ends :"TOTAL
STATEMENT".
It can be found in column A.
How I can copy this data from all of sheets and paste it into master sheet?

--
Greatly appreciated
Eva

See
http://www.rondebruin.nl/copy2.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Eva" wrote in message ...
Hi
Thank you for your response, but it is not exactly what I want. There are
about 20 sheets and I was thinking about the macro, that copy the same
section in all sheets and paste it into master sheet.
--
Greatly appreciated
Eva


"ryguy7272" wrote:

Data Filter Auto Filter

Custom

Items Begin With...Summary by Customer Category
And
Items End with...TOTAL

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Eva" wrote:

Hi
I have number of sheets with some data. In all of them there is a sequence
of data starting:"Summary by Customer Category" and it ends :"TOTAL
STATEMENT".
It can be found in column A.
How I can copy this data from all of sheets and paste it into master sheet?

--
Greatly appreciated
Eva

I'll try to make this simple (and short; am tired now).

Create a sheet named 'SummarySheet2'.

Add a button on any sheet. Link the button to Macro1(in module1):
Sub Macro1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("SummarySheet1").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "SummarySheet1"

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row = StartRow copy the
CopyRng
If shLast 0 And shLast = StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to
copy the
'values or want to copy everything look below example 1 on
this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Add a button...ON SHEET NAMED 'SummarySheet1'.
Link the button to Macro2 (in module2);
Sub Macro2()
'Note: This macro use the function LastRow
Dim My_Range As Range
Dim DestSh As Worksheet
Dim CalcMode As Long
Dim ViewMode As Long
Dim FilterCriteria As String
Dim CCount As Long
Dim rng As Range

Set My_Range = Range("A1:AZ" & LastRow(ActiveSheet))
My_Range.Parent.Select

Set DestSh = Sheets("SummarySheet2")

If ActiveWorkbook.ProtectStructure = True Or _
My_Range.Parent.ProtectContents = True Then
MsgBox "Sorry, not working when the workbook or worksheet is
protected", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
End If

'Change ScreenUpdating, Calculation, EnableEvents, ....
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False

'Firstly, remove the AutoFilter
My_Range.Parent.AutoFilterMode = False

My_Range.AutoFilter Field:=1, Criteria1:="=Summary by Customer
Category*" _
, Operator:=xlAnd, Criteria2:="=*TOTAL STATEMENT"

CCount = 0
On Error Resume Next
CCount =
My_Range.Columns(1).SpecialCells(xlCellTypeVisible ).Areas(1).Cells.Count
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 areas:" _
& vbNewLine & "It is not possible to copy the visible data." _
& vbNewLine & "Tip: Sort your data before you use this macro.", _
vbOKOnly, "Copy to worksheet"
Else
'Copy the visible data and use PasteSpecial to paste to the Destsh
With My_Range.Parent.AutoFilter.Range
On Error Resume Next
' Set rng to the visible cells in My_Range without the header row
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
'Copy and paste the cells into DestSh below the existing data
rng.Copy
With DestSh.Range("A" & LastRow(DestSh) + 1)
' Paste:=8 will copy the columnwidth in Excel 2000 and
higher
' Remove this line if you use Excel 97
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
'Delete the rows in the My_Range.Parent worksheet
'rng.EntireRow.Delete
End If
End With
End If

'Close AutoFilter
My_Range.Parent.AutoFilterMode = False

'Restore ScreenUpdating, Calculation, EnableEvents, ....
ActiveWindow.View = ViewMode
Application.Goto DestSh.Range("A1")
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


That should work fine. If you still have problems, post back, with specific
details of what happens.

HTH,
Ryan--


"Ron de Bruin" wrote:

See
http://www.rondebruin.nl/copy2.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Eva" wrote in message ...
Hi
Thank you for your response, but it is not exactly what I want. There are
about 20 sheets and I was thinking about the macro, that copy the same
section in all sheets and paste it into master sheet.
--
Greatly appreciated
Eva


"ryguy7272" wrote:

Data Filter Auto Filter

Custom

Items Begin With...Summary by Customer Category
And
Items End with...TOTAL

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Eva" wrote:

Hi
I have number of sheets with some data. In all of them there is a sequence
of data starting:"Summary by Customer Category" and it ends :"TOTAL
STATEMENT".
It can be found in column A.
How I can copy this data from all of sheets and paste it into master sheet?

--
Greatly appreciated
Eva
.

Hi RyGuy
Thank you for your code. I got distracted today and had to do something
else, but I am going to test it tomorrow and I will let you know how it will
work.

--
Greatly appreciated
Eva


"RyGuy" wrote:

I'll try to make this simple (and short; am tired now).

Create a sheet named 'SummarySheet2'.

Add a button on any sheet. Link the button to Macro1(in module1):
Sub Macro1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("SummarySheet1").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "SummarySheet1"

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row = StartRow copy the
CopyRng
If shLast 0 And shLast = StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to
copy the
'values or want to copy everything look below example 1 on
this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Add a button...ON SHEET NAMED 'SummarySheet1'.
Link the button to Macro2 (in module2);
Sub Macro2()
'Note: This macro use the function LastRow
Dim My_Range As Range
Dim DestSh As Worksheet
Dim CalcMode As Long
Dim ViewMode As Long
Dim FilterCriteria As String
Dim CCount As Long
Dim rng As Range

Set My_Range = Range("A1:AZ" & LastRow(ActiveSheet))
My_Range.Parent.Select

Set DestSh = Sheets("SummarySheet2")

If ActiveWorkbook.ProtectStructure = True Or _
My_Range.Parent.ProtectContents = True Then
MsgBox "Sorry, not working when the workbook or worksheet is
protected", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
End If

'Change ScreenUpdating, Calculation, EnableEvents, ....
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False

'Firstly, remove the AutoFilter
My_Range.Parent.AutoFilterMode = False

My_Range.AutoFilter Field:=1, Criteria1:="=Summary by Customer
Category*" _
, Operator:=xlAnd, Criteria2:="=*TOTAL STATEMENT"

CCount = 0
On Error Resume Next
CCount =
My_Range.Columns(1).SpecialCells(xlCellTypeVisible ).Areas(1).Cells.Count
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 areas:" _
& vbNewLine & "It is not possible to copy the visible data." _
& vbNewLine & "Tip: Sort your data before you use this macro.", _
vbOKOnly, "Copy to worksheet"
Else
'Copy the visible data and use PasteSpecial to paste to the Destsh
With My_Range.Parent.AutoFilter.Range
On Error Resume Next
' Set rng to the visible cells in My_Range without the header row
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
'Copy and paste the cells into DestSh below the existing data
rng.Copy
With DestSh.Range("A" & LastRow(DestSh) + 1)
' Paste:=8 will copy the columnwidth in Excel 2000 and
higher
' Remove this line if you use Excel 97
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
'Delete the rows in the My_Range.Parent worksheet
'rng.EntireRow.Delete
End If
End With
End If

'Close AutoFilter
My_Range.Parent.AutoFilterMode = False

'Restore ScreenUpdating, Calculation, EnableEvents, ....
ActiveWindow.View = ViewMode
Application.Goto DestSh.Range("A1")
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


That should work fine. If you still have problems, post back, with specific
details of what happens.

HTH,
Ryan--


"Ron de Bruin" wrote:

See
http://www.rondebruin.nl/copy2.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Eva" wrote in message ...
Hi
Thank you for your response, but it is not exactly what I want. There are
about 20 sheets and I was thinking about the macro, that copy the same
section in all sheets and paste it into master sheet.
--
Greatly appreciated
Eva


"ryguy7272" wrote:

Data Filter Auto Filter

Custom

Items Begin With...Summary by Customer Category
And
Items End with...TOTAL

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Eva" wrote:

Hi
I have number of sheets with some data. In all of them there is a sequence
of data starting:"Summary by Customer Category" and it ends :"TOTAL
STATEMENT".
It can be found in column A.
How I can copy this data from all of sheets and paste it into master sheet?

--
Greatly appreciated
Eva
.

Hi
I tested both macros. The first one works fine - it copies all data to one
sheet called SummarySheet1. The second one doesn't work and I stepped into to
see what is not working properly. When it gets to
My_Range.AutoFilter Field:=1, Criteria1:="=Summary by Customer Category*" _
, Operator:=xlAnd, Criteria2:="=*TOTAL STATEMENT"
Filters blank rows.
I don't understand VB so well to fix it, so if you have a time please have a
look at this.
I really appreciate your help
Eva


"RyGuy" wrote:

I'll try to make this simple (and short; am tired now).

Create a sheet named 'SummarySheet2'.

Add a button on any sheet. Link the button to Macro1(in module1):
Sub Macro1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("SummarySheet1").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "SummarySheet1"

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row = StartRow copy the
CopyRng
If shLast 0 And shLast = StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to
copy the
'values or want to copy everything look below example 1 on
this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Add a button...ON SHEET NAMED 'SummarySheet1'.
Link the button to Macro2 (in module2);
Sub Macro2()
'Note: This macro use the function LastRow
Dim My_Range As Range
Dim DestSh As Worksheet
Dim CalcMode As Long
Dim ViewMode As Long
Dim FilterCriteria As String
Dim CCount As Long
Dim rng As Range

Set My_Range = Range("A1:AZ" & LastRow(ActiveSheet))
My_Range.Parent.Select

Set DestSh = Sheets("SummarySheet2")

If ActiveWorkbook.ProtectStructure = True Or _
My_Range.Parent.ProtectContents = True Then
MsgBox "Sorry, not working when the workbook or worksheet is
protected", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
End If

'Change ScreenUpdating, Calculation, EnableEvents, ....
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False

'Firstly, remove the AutoFilter
My_Range.Parent.AutoFilterMode = False

My_Range.AutoFilter Field:=1, Criteria1:="=Summary by Customer
Category*" _
, Operator:=xlAnd, Criteria2:="=*TOTAL STATEMENT"

CCount = 0
On Error Resume Next
CCount =
My_Range.Columns(1).SpecialCells(xlCellTypeVisible ).Areas(1).Cells.Count
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 areas:" _
& vbNewLine & "It is not possible to copy the visible data." _
& vbNewLine & "Tip: Sort your data before you use this macro.", _
vbOKOnly, "Copy to worksheet"
Else
'Copy the visible data and use PasteSpecial to paste to the Destsh
With My_Range.Parent.AutoFilter.Range
On Error Resume Next
' Set rng to the visible cells in My_Range without the header row
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
'Copy and paste the cells into DestSh below the existing data
rng.Copy
With DestSh.Range("A" & LastRow(DestSh) + 1)
' Paste:=8 will copy the columnwidth in Excel 2000 and
higher
' Remove this line if you use Excel 97
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
'Delete the rows in the My_Range.Parent worksheet
'rng.EntireRow.Delete
End If
End With
End If

'Close AutoFilter
My_Range.Parent.AutoFilterMode = False

'Restore ScreenUpdating, Calculation, EnableEvents, ....
ActiveWindow.View = ViewMode
Application.Goto DestSh.Range("A1")
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


That should work fine. If you still have problems, post back, with specific
details of what happens.

HTH,
Ryan--


"Ron de Bruin" wrote:

See
http://www.rondebruin.nl/copy2.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Eva" wrote in message ...
Hi
Thank you for your response, but it is not exactly what I want. There are
about 20 sheets and I was thinking about the macro, that copy the same
section in all sheets and paste it into master sheet.
--
Greatly appreciated
Eva


"ryguy7272" wrote:

Data Filter Auto Filter

Custom

Items Begin With...Summary by Customer Category
And
Items End with...TOTAL

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Eva" wrote:

Hi
I have number of sheets with some data. In all of them there is a sequence
of data starting:"Summary by Customer Category" and it ends :"TOTAL
STATEMENT".
It can be found in column A.
How I can copy this data from all of sheets and paste it into master sheet?

--
Greatly appreciated
Eva
.