Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Find matches in different spreasheets then copy and paste to new s

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,522
Default Find matches in different spreasheets then copy and paste to new s

what kind of value, how many possible matches per worksheet? Is the new
sheet already there or does the macro need to create it?, etc..............

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"newlearner01" wrote in message
...
Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will
search
for string value in the second column ("B") of the first 41 sheets and if
it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,501
Default Find matches in different spreasheets then copy and paste to new s

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 74
Default Find matches in different spreasheets then copy and paste to n

Mike:

Very nice use of advanced features. Could you provide me with the proper
"type" for the following variables:

Dim sht
Dim myrange
Dim C

They were not included in the example.
--
Rich Locus
Logicwurks, LLC


"Mike H" wrote:

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Find matches in different spreasheets then copy and paste to n

There are less than 20 possible matches per sheet, and I need to create new
sheet. The value is text.

Thank for asking.

"Don Guillett" wrote:

what kind of value, how many possible matches per worksheet? Is the new
sheet already there or does the macro need to create it?, etc..............

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"newlearner01" wrote in message
...
Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will
search
for string value in the second column ("B") of the first 41 sheets and if
it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.


.



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Find matches in different spreasheets then copy and paste to n

Thanks. As Rich said, very nice use of advanced features. Both codes work,
but yours runs very fast.

"Mike H" wrote:

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 74
Default Find matches in different spreasheets then copy and paste to n

Mike:

Love the speed of the copy solution for this post. Do you know how to just
copy the values and not the formatting? The copy statement in your example
copies everything, including formatting and cell colors. Is there a way to
copy that works more like a "Paste Special, values only?"

--
Rich Locus
Logicwurks, LLC


"Mike H" wrote:

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.

  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,501
Default Find matches in different spreasheets then copy and paste to n

Dim sht as object
Dim myrange as range
Dim C as range

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Rich Locus" wrote:

Mike:

Very nice use of advanced features. Could you provide me with the proper
"type" for the following variables:

Dim sht
Dim myrange
Dim C

They were not included in the example.
--
Rich Locus
Logicwurks, LLC


"Mike H" wrote:

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.

  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Find matches in different spreasheets then copy and paste to n

Yes, it will be great if we have that addition option.

BTW, I would like to add the reference sheet names in the column A, and the
copied rows will start from column B of new sheet ("result" in your example)
so that we know from where those copied rows come. How can I add sheet names
to the Set CopyRange statement?

Thanks.

"Rich Locus" wrote:

Mike:

Love the speed of the copy solution for this post. Do you know how to just
copy the values and not the formatting? The copy statement in your example
copies everything, including formatting and cell colors. Is there a way to
copy that works more like a "Paste Special, values only?"

--
Rich Locus
Logicwurks, LLC


"Mike H" wrote:

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.

  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 74
Default Find matches in different spreasheets then copy and paste to n

Hello again :)

Here's a minor tweak to the code from Mike H that does a Paste Special for
values only and doesn't change colors, fonts or anything else:

Option Explicit
Sub copyrows()
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
Dim sht
Dim myrange As Range
Dim C

' Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"

MyValue = "WhatImLookingFor"
For x = 1 To 2
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next

If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy
Sheets("Results").Select
Cells(LastRow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Cells(1, 1).Select
Set CopyRange = Nothing
End If
Next
Sheets(1).Select
Cells(1, 1).Select

End Sub

--
Rich Locus
Logicwurks, LLC


"newlearner01" wrote:

Yes, it will be great if we have that addition option.

BTW, I would like to add the reference sheet names in the column A, and the
copied rows will start from column B of new sheet ("result" in your example)
so that we know from where those copied rows come. How can I add sheet names
to the Set CopyRange statement?

Thanks.

"Rich Locus" wrote:

Mike:

Love the speed of the copy solution for this post. Do you know how to just
copy the values and not the formatting? The copy statement in your example
copies everything, including formatting and cell colors. Is there a way to
copy that works more like a "Paste Special, values only?"

--
Rich Locus
Logicwurks, LLC


"Mike H" wrote:

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.



  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 74
Default Find matches in different spreasheets then copy and paste to n

Here's another change that allows the rows from the first 41 spreadsheets
(only the first 30 columns are copied, but you can change that to make it
bigger or smaller) to be copied to Column B of results, with the name of the
spreadsheet in Column A:

Sub copyrows()
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
Dim sht
Dim myrange As Range
Dim C

Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
MyValue = "WhatImLookingFor"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = Range(C, C.Offset(0, 30))
Else
Set CopyRange = Union(CopyRange, Range(C, C.Offset(0, 30)))
End If
End If
Next

If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "B").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("B" & LastRow)
Sheets("Results").Cells(LastRow, 1).Value = sht.Name
Set CopyRange = Nothing
End If
Next
End Sub

--
Rich Locus
Logicwurks, LLC


"Rich Locus" wrote:

Hello again :)

Here's a minor tweak to the code from Mike H that does a Paste Special for
values only and doesn't change colors, fonts or anything else:

Option Explicit
Sub copyrows()
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
Dim sht
Dim myrange As Range
Dim C

' Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"

MyValue = "WhatImLookingFor"
For x = 1 To 2
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next

If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy
Sheets("Results").Select
Cells(LastRow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Cells(1, 1).Select
Set CopyRange = Nothing
End If
Next
Sheets(1).Select
Cells(1, 1).Select

End Sub

--
Rich Locus
Logicwurks, LLC


"newlearner01" wrote:

Yes, it will be great if we have that addition option.

BTW, I would like to add the reference sheet names in the column A, and the
copied rows will start from column B of new sheet ("result" in your example)
so that we know from where those copied rows come. How can I add sheet names
to the Set CopyRange statement?

Thanks.

"Rich Locus" wrote:

Mike:

Love the speed of the copy solution for this post. Do you know how to just
copy the values and not the formatting? The copy statement in your example
copies everything, including formatting and cell colors. Is there a way to
copy that works more like a "Paste Special, values only?"

--
Rich Locus
Logicwurks, LLC


"Mike H" wrote:

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.

  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Find matches in different spreasheets then copy and paste to n

Thanks again Rich

It's interesting that this version finds more matches than Mike's original
code. Somehow, Mike's code ignores hidden rows, and the rows whose first
columns are empty. However, yours does not copy/paste first column of the
existing sheets. How can we modify code to fix it? Can you please show me how
to modify code to search in any column (ex: column 1 or 10)?

Also, both codes ignore several matches in a few spreadsheets. When I use
Find tool, Excel does overlook those matches too. Is that a bug in Excel? Im
using Excel 2007.


"Rich Locus" wrote:

Here's another change that allows the rows from the first 41 spreadsheets
(only the first 30 columns are copied, but you can change that to make it
bigger or smaller) to be copied to Column B of results, with the name of the
spreadsheet in Column A:

Sub copyrows()
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
Dim sht
Dim myrange As Range
Dim C

Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
MyValue = "WhatImLookingFor"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = Range(C, C.Offset(0, 30))
Else
Set CopyRange = Union(CopyRange, Range(C, C.Offset(0, 30)))
End If
End If
Next

If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "B").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("B" & LastRow)
Sheets("Results").Cells(LastRow, 1).Value = sht.Name
Set CopyRange = Nothing
End If
Next
End Sub

--
Rich Locus
Logicwurks, LLC


"Rich Locus" wrote:

Hello again :)

Here's a minor tweak to the code from Mike H that does a Paste Special for
values only and doesn't change colors, fonts or anything else:

Option Explicit
Sub copyrows()
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
Dim sht
Dim myrange As Range
Dim C

' Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"

MyValue = "WhatImLookingFor"
For x = 1 To 2
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next

If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy
Sheets("Results").Select
Cells(LastRow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Cells(1, 1).Select
Set CopyRange = Nothing
End If
Next
Sheets(1).Select
Cells(1, 1).Select

End Sub

--
Rich Locus
Logicwurks, LLC


"newlearner01" wrote:

Yes, it will be great if we have that addition option.

BTW, I would like to add the reference sheet names in the column A, and the
copied rows will start from column B of new sheet ("result" in your example)
so that we know from where those copied rows come. How can I add sheet names
to the Set CopyRange statement?

Thanks.

"Rich Locus" wrote:

Mike:

Love the speed of the copy solution for this post. Do you know how to just
copy the values and not the formatting? The copy statement in your example
copies everything, including formatting and cell colors. Is there a way to
copy that works more like a "Paste Special, values only?"

--
Rich Locus
Logicwurks, LLC


"Mike H" wrote:

Hi,

try this

Sub copyrows()
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Results"
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
MyValue = "Somestring"
For x = 1 To 41
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = sht.Range("B1:B" & LastRow)
For Each C In myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"newlearner01" wrote:

Hi,

I am a new in VBA and I am wondering whether someone can help me?

My workwork has 45 sheets. I would like to create a macro which will search
for string value in the second column ("B") of the first 41 sheets and if it
finds the matches it will copy entire row and paste to new sheet in same
workbook.

Thanks in advance.

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Range to find matches to copy values talonega149 Excel Programming 7 November 4th 09 09:57 PM
Range to find matches to copy values Dwayne Pelletier Excel Programming 0 November 4th 09 08:07 PM
Find, Copy and Paste Fabian Excel Programming 2 November 25th 08 08:59 PM
Find/Copy/paste.. then Find/Paste - not working ... at all.... [email protected] Excel Programming 9 November 30th 06 08:49 PM
Find Copy and Paste RigasMinho Excel Programming 4 July 17th 06 09:32 PM


All times are GMT +1. The time now is 11:19 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"