Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Seach all WS
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default Seach all WS
Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Seach all WS
Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default Seach all WS
How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Seach all WS
I'm confused.

The line that you use to determine the destination cell is:

Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)

It looks at the last used cell of column A, then goes down 19 rows.

If you really want to start in A17 no matter what's there, you could use:

Set rDest = .Parent.Sheets("Sheet2").range("a17")


====
Maybe you want to keep going down the range no matter what worksheet you're
on???

Something like:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

With Sheets("sheet2")
Set rDest = .Cells(.Rows.Count, 1).End(xlUp).Offset(19, 0)
'or
'Set rDest = .range("a17")
End With

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
End With

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub



Jerry Foley wrote:

How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson


--

Dave Peterson
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default Seach all WS
Yes...Is there a way to make the data written to sheet2 is inserted so the
total cells at the bottom of the col stays in tact?

"Jerry Foley" wrote:

How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Seach all WS
I don't know. It depends on how many cells are available for pasting and where
your data starts.

Maybe you could just insert a new row and paste into that?

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

Set rSource = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
End With

If (Not rSource Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
Worksheets("sheet2").Rows(17).Insert
.EntireRow.Copy _
Destination:=Worksheets("sheet2").Range("a17")
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Yes...Is there a way to make the data written to sheet2 is inserted so the
total cells at the bottom of the col stays in tact?

"Jerry Foley" wrote:

How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson


--

Dave Peterson
Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default Seach all WS
Great help Dave...I have hopefully one last question...when i run this macro
it is now reading the rows fine but when it inserts it to sheet2, it is
inserting above the last line so that all of the data is bottom to top
instead of top to bottom. any fix ideas?

"Dave Peterson" wrote:

I don't know. It depends on how many cells are available for pasting and where
your data starts.

Maybe you could just insert a new row and paste into that?

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

Set rSource = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
End With

If (Not rSource Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
Worksheets("sheet2").Rows(17).Insert
.EntireRow.Copy _
Destination:=Worksheets("sheet2").Range("a17")
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Yes...Is there a way to make the data written to sheet2 is inserted so the
total cells at the bottom of the col stays in tact?

"Jerry Foley" wrote:

How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson


--

Dave Peterson

Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Seach all WS
I'm still not quite sure what's happening, but maybe just going from the bottom
to the top would be sufficient:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rCell As Range
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))
With wks
FirstRow = 4
LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
End With

For iRow = LastRow To FirstRow Step -1
Set rCell = wks.Cells(iRow, 4)
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
Worksheets("sheet2").Rows(17).Insert
.EntireRow.Copy _
Destination:=Worksheets("sheet2").Range("a17")
End If
End If
End With
End If
Next wks
End Sub



Jerry Foley wrote:

Great help Dave...I have hopefully one last question...when i run this macro
it is now reading the rows fine but when it inserts it to sheet2, it is
inserting above the last line so that all of the data is bottom to top
instead of top to bottom. any fix ideas?

"Dave Peterson" wrote:

I don't know. It depends on how many cells are available for pasting and where
your data starts.

Maybe you could just insert a new row and paste into that?

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

Set rSource = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
End With

If (Not rSource Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
Worksheets("sheet2").Rows(17).Insert
.EntireRow.Copy _
Destination:=Worksheets("sheet2").Range("a17")
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Yes...Is there a way to make the data written to sheet2 is inserted so the
total cells at the bottom of the col stays in tact?

"Jerry Foley" wrote:

How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson
Reply With QuoteReply With Quote
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27
Default Seach all WS
Hey Dave,
The last macro you gave me is getting compile erros at the end. The issue
prior to this is the data being copied from the wks are being copied in
reverse order, i.e. row 9 gets copied to sheet 2 ahead of row 8 etc...

"Dave Peterson" wrote:

I'm still not quite sure what's happening, but maybe just going from the bottom
to the top would be sufficient:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rCell As Range
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))
With wks
FirstRow = 4
LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
End With

For iRow = LastRow To FirstRow Step -1
Set rCell = wks.Cells(iRow, 4)
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
Worksheets("sheet2").Rows(17).Insert
.EntireRow.Copy _
Destination:=Worksheets("sheet2").Range("a17")
End If
End If
End With
End If
Next wks
End Sub



Jerry Foley wrote:

Great help Dave...I have hopefully one last question...when i run this macro
it is now reading the rows fine but when it inserts it to sheet2, it is
inserting above the last line so that all of the data is bottom to top
instead of top to bottom. any fix ideas?

"Dave Peterson" wrote:

I don't know. It depends on how many cells are available for pasting and where
your data starts.

Maybe you could just insert a new row and paste into that?

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

Set rSource = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
End With

If (Not rSource Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
Worksheets("sheet2").Rows(17).Insert
.EntireRow.Copy _
Destination:=Worksheets("sheet2").Range("a17")
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Yes...Is there a way to make the data written to sheet2 is inserted so the
total cells at the bottom of the col stays in tact?

"Jerry Foley" wrote:

How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson

Reply With QuoteReply With Quote
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Seach all WS
That last "end if" should have been "next irow"

sorry.

Jerry Foley wrote:

Hey Dave,
The last macro you gave me is getting compile erros at the end. The issue
prior to this is the data being copied from the wks are being copied in
reverse order, i.e. row 9 gets copied to sheet 2 ahead of row 8 etc...

"Dave Peterson" wrote:

I'm still not quite sure what's happening, but maybe just going from the bottom
to the top would be sufficient:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rCell As Range
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))
With wks
FirstRow = 4
LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
End With

For iRow = LastRow To FirstRow Step -1
Set rCell = wks.Cells(iRow, 4)
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
Worksheets("sheet2").Rows(17).Insert
.EntireRow.Copy _
Destination:=Worksheets("sheet2").Range("a17")
End If
End If
End With
End If
Next wks
End Sub



Jerry Foley wrote:

Great help Dave...I have hopefully one last question...when i run this macro
it is now reading the rows fine but when it inserts it to sheet2, it is
inserting above the last line so that all of the data is bottom to top
instead of top to bottom. any fix ideas?

"Dave Peterson" wrote:

I don't know. It depends on how many cells are available for pasting and where
your data starts.

Maybe you could just insert a new row and paste into that?

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

Set rSource = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
End With

If (Not rSource Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
Worksheets("sheet2").Rows(17).Insert
.EntireRow.Copy _
Destination:=Worksheets("sheet2").Range("a17")
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Yes...Is there a way to make the data written to sheet2 is inserted so the
total cells at the bottom of the col stays in tact?

"Jerry Foley" wrote:

How can I modify this macro to write the data on sheet2 starting at line 17
and continue down. It now writes the data at line 19 but seems to be
truncating the data upwards.

"Dave Peterson" wrote:

Option Explicit
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range
Dim wks As Worksheet

For Each wks In Worksheets(Array("New IP Office", "New Avaya"))

On Error Resume Next
Set rSource = Nothing
Set rDest = Nothing
With wks
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error Resume Next

If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
Next wks
End Sub


Jerry Foley wrote:

Hello,
given
Sub mastertest1()
Dim rSource As Range
Dim rDest As Range
Dim rCell As Range

On Error Resume Next
With ThisWorkbook.Sheets("New IP Office")
Set rSource = .Range(.Cells(1, 4), _
.Cells(.Rows.Count, 4).End(xlUp))
Set rDest = .Parent.Sheets("Sheet2").Cells( _
.Rows.Count, 1).End(xlUp).Offset(19, 0)
End With
On Error GoTo 0
If (Not rSource Is Nothing) And (Not rDest Is Nothing) Then
For Each rCell In rSource
With rCell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
.EntireRow.Copy Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End If
End With
Next rCell
End If
End Sub
How do I make this macro search ws named New Avaya also?
Thanks

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson


--

Dave Peterson
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

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
excel seach Excel-lent Novice Excel Worksheet Functions 1 June 27th 08 11:12 PM
Seach & Replace Macro NQ Muzza Excel Programming 1 June 7th 06 03:34 PM
Dynamic Seach Values gti_jobert[_12_] Excel Programming 3 February 8th 06 04:27 PM
seach and replace '(' with an '/' Splt Window Diner Excel Discussion (Misc queries) 4 August 20th 05 03:19 PM
File name seach within open filetype Andrew[_27_] Excel Programming 0 January 21st 04 06:20 PM


All times are GMT +1. The time now is 03:55 AM.

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

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement