Find range in one sheet, then paste in the other (one by one)
 

Hi all,

Here's my problem:

- In sheets(1), identify a particular cell if it is BLANK.
(for n = 5000 to 1 step -1)
- Copy entire row (containing this particular blank cell).
- Select the next sheet (activate)
- paste the row from sheets(1) to this sheet.
(for n1 = 1 to 500)
i.e. identify the next available row before pasting.

In short, I need to display (a list in the next sheet) of all those
rows (in sheets(1)) that have a blank cell.


ActiveWorkbook.Worksheets(1).Select
For n = 5000 To 1 Step -1
If Cells(n, 2) < "" And Cells(n, 10) = "" Then
Range(Cells(n, 1), Cells(n, 19)).Select
Selection.Copy
GoTo line1
End If
Next n


line1:
ActiveWorkbook.Worksheets(2).Select
For N1 = 1 To 500
If Cells(N1, 2) < "" Then
Selection.Paste
End If
End
Next N1

I am trying this approach - but am still stuck. Appreciate your help.

Tks/Brgds
cskgg


---
Message posted from http://www.ExcelForum.com/

Find range in one sheet, then paste in the other (one by one)
 

Try this method.......

Sub blanks()
Dim n As Long, iout As Long
Application.ScreenUpdating = False
iout = 1 'start of destination row
Sheets("Sheet1").Activate
For n = 5000 To 1 Step -1
If Cells(n, 2) < "" And Trim(Cells(n, 10)) = "" Then
Range(Cells(n, 1), Cells(n, 19)).Copy
Sheets("Sheet2").Cells(iout, 1).PasteSpecial Paste:=xlPasteValues
iout = iout + 1
End If
Next n
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Cheers
Nigel

"cskgg " wrote in message
...
Hi all,

Here's my problem:

- In sheets(1), identify a particular cell if it is BLANK.
(for n = 5000 to 1 step -1)
- Copy entire row (containing this particular blank cell).
- Select the next sheet (activate)
- paste the row from sheets(1) to this sheet.
(for n1 = 1 to 500)
i.e. identify the next available row before pasting.

In short, I need to display (a list in the next sheet) of all those
rows (in sheets(1)) that have a blank cell.


ActiveWorkbook.Worksheets(1).Select
For n = 5000 To 1 Step -1
If Cells(n, 2) < "" And Cells(n, 10) = "" Then
Range(Cells(n, 1), Cells(n, 19)).Select
Selection.Copy
GoTo line1
End If
Next n


line1:
ActiveWorkbook.Worksheets(2).Select
For N1 = 1 To 500
If Cells(N1, 2) < "" Then
Selection.Paste
End If
End
Next N1

I am trying this approach - but am still stuck. Appreciate your help.

Tks/Brgds
cskgg


---
Message posted from http://www.ExcelForum.com/

Find range in one sheet, then paste in the other (one by one)
 

Dear Nigel,

Thank you ever so much. It works.
Incidentally, I also found out a "round-about" way - (not a good way o
programming I am sure) but it works:
=========
Sub CHECKLIST()

Application.ScreenUpdating = False
ActiveWorkbook.Worksheets(2).Select
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Delete Shift:=xlUp
ActiveWorkbook.Worksheets(1).Select
Range(Cells(2, 1), Cells(2, 19)).Select
Selection.Copy
ActiveWorkbook.Worksheets(2).Select
Cells(2, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Worksheets(1).Select
For N = 50 To 3 Step -1
If Cells(N, 2) < "" And Cells(N, 10) = "" Then
Range(Cells(N, 1), Cells(N, 19)).Select
Selection.Copy
ActiveWorkbook.Worksheets(2).Select
For N1 = 4 To 50
If Cells(N1, 2) = "" Then
Cells(N1, 1).Select
ActiveSheet.Paste
Cells(N1, 2).Select


GoTo LINE2
Else
End If
Next N1
LINE2:
End If
ActiveWorkbook.Worksheets(1).Select
Next N
ActiveWorkbook.Worksheets(2).Select
If Range("B4") = "" Then
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Delete Shift:=xlUp
choice = MsgBox("All entries have Account Code", vbOKOnly
vbInformation)
If choice = vbOK Then
ActiveWorkbook.Worksheets(1).Select
Range("a1").Select
Application.CutCopyMode = False
End If
End If
End
End Sub

============

cskgg wrote:
*Hi all,

Here's my problem:

- In sheets(1), identify a particular cell if it is BLANK.
(for n = 5000 to 1 step -1)
- Copy entire row (containing this particular blank cell).
- Select the next sheet (activate)
- paste the row from sheets(1) to this sheet.
(for n1 = 1 to 500)
i.e. identify the next available row before pasting.

In short, I need to display (a list in the next sheet) of all thos
rows (in sheets(1)) that have a blank cell.


ActiveWorkbook.Worksheets(1).Select
For n = 5000 To 1 Step -1
If Cells(n, 2) < "" And Cells(n, 10) = "" Then
Range(Cells(n, 1), Cells(n, 19)).Select
Selection.Copy
GoTo line1
End If
Next n


line1:
ActiveWorkbook.Worksheets(2).Select
For N1 = 1 To 500
If Cells(N1, 2) < "" Then
Selection.Paste
End If
End
Next N1

I am trying this approach - but am still stuck. Appreciate you
help.

Tks/Brgds
cskgg

--
Message posted from http://www.ExcelForum.com

Find range in one sheet, then paste in the other (one by one)
 

Generally all those 'selects' are not required and just slow everything up.
Take a look at using With constructs as well as this removes a lot of code
and simplifies things enormously.

Cheers
Nigel
..
"cskgg " wrote in message
...
Dear Nigel,

Thank you ever so much. It works.
Incidentally, I also found out a "round-about" way - (not a good way of
programming I am sure) but it works:
=========
Sub CHECKLIST()

Application.ScreenUpdating = False
ActiveWorkbook.Worksheets(2).Select
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Delete Shift:=xlUp
ActiveWorkbook.Worksheets(1).Select
Range(Cells(2, 1), Cells(2, 19)).Select
Selection.Copy
ActiveWorkbook.Worksheets(2).Select
Cells(2, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Worksheets(1).Select
For N = 50 To 3 Step -1
If Cells(N, 2) < "" And Cells(N, 10) = "" Then
Range(Cells(N, 1), Cells(N, 19)).Select
Selection.Copy
ActiveWorkbook.Worksheets(2).Select
For N1 = 4 To 50
If Cells(N1, 2) = "" Then
Cells(N1, 1).Select
ActiveSheet.Paste
Cells(N1, 2).Select


GoTo LINE2
Else
End If
Next N1
LINE2:
End If
ActiveWorkbook.Worksheets(1).Select
Next N
ActiveWorkbook.Worksheets(2).Select
If Range("B4") = "" Then
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Delete Shift:=xlUp
choice = MsgBox("All entries have Account Code", vbOKOnly +
vbInformation)
If choice = vbOK Then
ActiveWorkbook.Worksheets(1).Select
Range("a1").Select
Application.CutCopyMode = False
End If
End If
End
End Sub

============

cskgg wrote:
*Hi all,

Here's my problem:

- In sheets(1), identify a particular cell if it is BLANK.
(for n = 5000 to 1 step -1)
- Copy entire row (containing this particular blank cell).
- Select the next sheet (activate)
- paste the row from sheets(1) to this sheet.
(for n1 = 1 to 500)
i.e. identify the next available row before pasting.

In short, I need to display (a list in the next sheet) of all those
rows (in sheets(1)) that have a blank cell.


ActiveWorkbook.Worksheets(1).Select
For n = 5000 To 1 Step -1
If Cells(n, 2) < "" And Cells(n, 10) = "" Then
Range(Cells(n, 1), Cells(n, 19)).Select
Selection.Copy
GoTo line1
End If
Next n


line1:
ActiveWorkbook.Worksheets(2).Select
For N1 = 1 To 500
If Cells(N1, 2) < "" Then
Selection.Paste
End If
End
Next N1

I am trying this approach - but am still stuck. Appreciate your
help.

Tks/Brgds
cskgg *


---
Message posted from http://www.ExcelForum.com/