View Full Version : Solved: check the A Cloumn and copy to aother sheet
parscon
03-10-2012, 05:29 AM
I need a help , i have a list . that some items have not data on column A but they have data on column B and .... , I need a Macro code check if column A is blank copy their row to another sheet .
Thank you so much .
Bob Phillips
03-10-2012, 07:35 AM
Air code
With Activesheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
If .Cells(i, "A").Value = "" Then
nextrow = nextrow + 1
.Rows(i).Copy Worksheets("Sheet2").Cells(nextrow, "A")
End If
Next i
End With
parscon
03-10-2012, 08:38 AM
Thank you but , it is not work .
jonhaus
03-10-2012, 09:52 AM
I think this should work for you
Dim i As Integer
Dim x As Integer
Dim lastrow As Integer
With ActiveSheet
lastrow = Range("B1").End(xlDown).row
x = 1
For i = 1 To lastrow
If .Cells(i, 1).Value = "" Then
.Rows(i).Copy
Sheets("Sheet2").Rows(x).PasteSpecial (xlPasteAll)
x = x + 1
End If
Next i
End With
End Sub
-jonhaus
parscon
03-10-2012, 09:58 AM
Thank you , and it is work now .
parscon
03-10-2012, 11:05 AM
Could you please helo me if i want to move or cut these data what can i do ?
that mean will not be in sheet A .
jonhaus
03-10-2012, 11:43 AM
Glad to here it worked. Try something like this.
Sub CopyRows()
Dim i As Integer
Dim x As Integer
Dim lastrow As Integer
With ActiveSheet
lastrow = Range("B1").End(xlDown).row
x = 1
For i = 1 To
lastrow
If .Cells(i, 1).Value = "" Then
.Rows(i).Copy
Sheets("Sheet2").Rows(x).Insert Shift:=xlDown
.Rows(i).Delete
x = x + 1
End If
Next i
End With
End Sub
parscon
03-10-2012, 11:55 AM
Thank you but delete dose not work .
jonhaus
03-10-2012, 01:52 PM
Are you getting an error? I don't have any problem running it.
parscon
03-10-2012, 01:54 PM
I run it but it does not delete .
jonhaus
03-10-2012, 02:13 PM
Give this a shot I forgot to account that for the cell locations changing when the row is deleted.
Sub CopyRows()
Dim x As Integer
Dim lastrow As
Integer
With
ActiveSheet
x = 1
Do Until Len(Cells(x, 2).Value) = 0
If .Cells(x, 1).Value = "" Then
.Rows(x).Copy
Sheets("Sheet2").Rows(x).Insert
Shift:=xlDown
.Rows(x).Delete
Else
x = x + 1
End If
Loop
End With
End Sub
Bob Phillips
03-11-2012, 06:01 AM
Give this a shot I forgot to account that for the cell locations changing when the row is deleted.
The trick is to work-bottom up when deleting not top-down, then the cell locations do not change.
jonhaus
03-11-2012, 12:07 PM
Good idea! I have never thought of approaching it like that. I think my way will still work, but yours probably makes more since. Thanks.
parscon
04-03-2012, 11:17 AM
I have Still the Problem with this code
Sub CopyRows()
Dim x As Integer
Dim lastrow As Integer
With ActiveSheet
x = 1
Do Until Len(Cells(x, 2).Value) = 0
If .Cells(x, 1).Value = "" Then
.Rows(x).Copy
Sheets("Sheet2").Rows(x).Insert
Shift:=xlDown
.Rows(x).Delete
Else
x = x + 1
End If
Loop
End With
End Sub
1- This code will not copy to the first row of second sheet
2- i have 765233 row and when run this code i got error on 32767 Record. and when click on debug show me this line x = x + 1 and in my mouse hint show x= 32767 .
3- in there any other fast way ?
Thank you . Please help me on this subject .
CatDaddy
04-03-2012, 12:33 PM
1) Sheets("Sheet2").Rows(Sheets("Sheet2").Range(Cells.count,1).Row).Insert
Shift:=xlDown
2) Dim x as Long (not Integer)
3) at start of code insert:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
and at the end of your code set them both back to true
parscon
04-04-2012, 04:43 AM
Thanks to all . Now everything work fine .
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.