Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Paste blank cell row loop
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 12
Default Paste blank cell row loop
I am attempting to copy and paste to a new sheet any rows in each worksheet
which have a blank cell in column K.
The attached code does not loop through the worksheets but sticks in Sheet
1.

Can anyone help a grey haired, frustrated VBA dunce


Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = Range("K2", Range("K" & Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
Sheets("NotPaid").Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
ActiveCell.Offset(1, 0).Select
End If
Next i

' End If
Next WS


Rows("1:1").Select


End Sub


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default Paste blank cell row loop
I haven't tested it, but give this a try

Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = WS.Range("K2", WS.Range("K" & ws.Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
SHT.Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
End If
Next i

' End If
Next WS

Rows("1:1").Select

End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Ron Dean" wrote in message
. nl...
I am attempting to copy and paste to a new sheet any rows in each
worksheet
which have a blank cell in column K.
The attached code does not loop through the worksheets but sticks in Sheet
1.

Can anyone help a grey haired, frustrated VBA dunce


Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = Range("K2", Range("K" & Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
Sheets("NotPaid").Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
ActiveCell.Offset(1, 0).Select
End If
Next i

' End If
Next WS


Rows("1:1").Select


End Sub




Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 12
Default Paste blank cell row loop
Fabulous, Bob.

Can you briefly explain what was wrong with my attempt

Rob
+++++++++++++++++++++


"Bob Phillips" wrote in message
...
I haven't tested it, but give this a try

Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = WS.Range("K2", WS.Range("K" & ws.Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
SHT.Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
End If
Next i

' End If
Next WS

Rows("1:1").Select

End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Ron Dean" wrote in message
. nl...
I am attempting to copy and paste to a new sheet any rows in each
worksheet
which have a blank cell in column K.
The attached code does not loop through the worksheets but sticks in
Sheet
1.

Can anyone help a grey haired, frustrated VBA dunce


Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = Range("K2", Range("K" & Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
Sheets("NotPaid").Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
ActiveCell.Offset(1, 0).Select
End If
Next i

' End If
Next WS


Rows("1:1").Select


End Sub






Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default Paste blank cell row loop
Essentially you were not using the WS object that you so carefully primed.
This code

Set Rng = Range("K2", Range("K" & Rows.Count).End(xlUp))

I changed to

Set Rng = WS.Range("K2", WS.Range("K" & ws.Rows.Count).End(xlUp))

I also changed this

For Each i In Rng
If i = "" Then
i.EntireRow.Copy
Sheets("NotPaid").Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
ActiveCell.Offset(1, 0).Select
End If

as it didn't ned the cell selecting, and could use the SHT you declared
earlier

For Each i In Rng
If i = "" Then
i.EntireRow.Copy
SHT.Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
End If


--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Ron Dean" wrote in message
. nl...
Fabulous, Bob.

Can you briefly explain what was wrong with my attempt

Rob
+++++++++++++++++++++


"Bob Phillips" wrote in message
...
I haven't tested it, but give this a try

Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = WS.Range("K2", WS.Range("K" & ws.Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
SHT.Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
End If
Next i

' End If
Next WS

Rows("1:1").Select

End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Ron Dean" wrote in message
. nl...
I am attempting to copy and paste to a new sheet any rows in each
worksheet
which have a blank cell in column K.
The attached code does not loop through the worksheets but sticks in
Sheet
1.

Can anyone help a grey haired, frustrated VBA dunce


Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = Range("K2", Range("K" & Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
Sheets("NotPaid").Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
ActiveCell.Offset(1, 0).Select
End If
Next i

' End If
Next WS


Rows("1:1").Select


End Sub








Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 12
Default Paste blank cell row loop
In using this, the code stops after coping & pasting the 1st line of the 2nd
last sheet.
Any ideas



"Ron Dean" wrote in message
. nl...
Fabulous, Bob.

Can you briefly explain what was wrong with my attempt

Rob
+++++++++++++++++++++


"Bob Phillips" wrote in message
...
I haven't tested it, but give this a try

Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = WS.Range("K2", WS.Range("K" & ws.Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
SHT.Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
End If
Next i

' End If
Next WS

Rows("1:1").Select

End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Ron Dean" wrote in message
. nl...
I am attempting to copy and paste to a new sheet any rows in each
worksheet
which have a blank cell in column K.
The attached code does not loop through the worksheets but sticks in
Sheet
1.

Can anyone help a grey haired, frustrated VBA dunce


Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = Range("K2", Range("K" & Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
Sheets("NotPaid").Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
ActiveCell.Offset(1, 0).Select
End If
Next i

' End If
Next WS


Rows("1:1").Select


End Sub








Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default Paste blank cell row loop
I have just tested it Ron, and it ran fine for me. Any more details?

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Ron Dean" wrote in message
. nl...
In using this, the code stops after coping & pasting the 1st line of the
2nd
last sheet.
Any ideas



"Ron Dean" wrote in message
. nl...
Fabulous, Bob.

Can you briefly explain what was wrong with my attempt

Rob
+++++++++++++++++++++


"Bob Phillips" wrote in message
...
I haven't tested it, but give this a try

Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = WS.Range("K2", WS.Range("K" &
ws.Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
SHT.Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
End If
Next i

' End If
Next WS

Rows("1:1").Select

End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Ron Dean" wrote in message
. nl...
I am attempting to copy and paste to a new sheet any rows in each
worksheet
which have a blank cell in column K.
The attached code does not loop through the worksheets but sticks in
Sheet
1.

Can anyone help a grey haired, frustrated VBA dunce


Sub Non_Payment()

' ********* Header
Sheet1.Activate
Rows("1:1").Select
Selection.Copy

' ******* Make new sheet
Dim SHT As Object
On Error Resume Next
Set SHT = Sheets("NotPaid")
On Error GoTo 0
If SHT Is Nothing Then
Set SHT = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
SHT.Name = "NotPaid"
End If

'**** paste header
SHT.Activate
Rows("1:1").Select
ActiveSheet.Paste

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets
' If WS.Name < "NotPaid" Then

Dim Rng As Range
Dim i As Range
Set Rng = Range("K2", Range("K" & Rows.Count).End(xlUp))
Dim r As Integer
r = 2
For Each i In Rng
If i = "" Then
i.EntireRow.Copy
Sheets("NotPaid").Range("K" & Rows.Count).End(xlUp)(r). _
EntireRow.PasteSpecial
r = r + 1
ActiveCell.Offset(1, 0).Select
End If
Next i

' End If
Next WS


Rows("1:1").Select


End Sub










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
how to paste link and not get a zero in the blank cell? Margo M Excel Discussion (Misc queries) 2 October 15th 09 06:29 PM
paste values in blank cell Mayte Excel Worksheet Functions 7 June 2nd 08 10:57 PM
paste to next blank cell/row Yvette Excel Worksheet Functions 1 June 9th 06 03:34 PM
how do I generate a blank cell when I paste link; comes up - or 0 MitchP Excel Discussion (Misc queries) 3 July 22nd 05 07:09 PM
get for loop to go on after blank cell? john_t_h[_12_] Excel Programming 3 January 15th 04 06:35 AM


All times are GMT +1. The time now is 11:10 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"

 

Contact Us ExcelBanter forum home Privacy Statement