Copy non blank rows from one sheet and paste on another sheet on the first available blank row

[manojrf]

Hi there,

I have a macro that is not working properly.

When I run this, it copies 100 rows and 10 columns, which are blank and non blank, and paste it at the destination Sheet LIST and TOTAL LIST. The Sheet "LIST" gets cleared before the macro is run next time. When the macro is run again, the data is pasted on to the sheet "TOTAL LIST" after skipping 100 rows ( not on the first available blank cell in column B). If it is run again, it goes on like this.

The main data is created on the "SUBVN LIST". The purpose of this macro is to copy the non blank rows and then paste in to "LIST" AND "TOTAL LIST". "TOTAL LIST" becomes bigger and bigger with new data and "LIST" is just an temporary sheet. I hope I have made it clear.


Can anyone please help me out?


Thanks in advance.

Sub Copy()
Workbooks("AGL SUBVENTION TOTAL LIST").Activate
Worksheets("LIST").Cells.ClearContents
Workbooks("Gold loan new - SBI - MS Excel").Activate
Worksheets("SUBVN LIST").Select
Worksheets("SUBVN LIST").Range("A2", Range("A" & Rows.Count).End(xlUp).Offset(, 10)).Copy
Workbooks("AGL SUBVENTION TOTAL LIST").Activate
Worksheets("LIST").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Worksheets("TOTAL LIST").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False




Dim lr As Long, lr2 As Long, lr3 As Long, lr4 As Long, r As Long
lr = Sheets("LIST").Cells(Rows.Count, "B").End(xlUp).Row
lr2 = Sheets("UPTO 50000 18-19").Cells(Rows.Count, "B").End(xlUp).Row
lr3 = Sheets("ABOVE 50000 18-19").Cells(Rows.Count, "B").End(xlUp).Row
lr4 = Sheets("UPTO 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
lr5 = Sheets("ABOVE 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row


With Sheets("LIST")
For r = 2 To lr
If .Range("D" & r).Value <= 50000 And Range("K" & r).Value = "2018-19" Then
.Range("B" & r).Resize(, 11).Copy Destination:=Sheets("UPTO 50000 18-19").Range("B" & lr2 + 1)
lr2 = Sheets("UPTO 50000 18-19").Cells(Rows.Count, "B").End(xlUp).Row
End If


If .Range("D" & r).Value > 50000 And Range("K" & r).Value = "2018-19" Then
.Range("B" & r).Resize(, 11).Copy Destination:=Sheets("ABOVE 50000 18-19").Range("B" & lr3 + 1)
lr3 = Sheets("ABOVE 50000 18-19").Cells(Rows.Count, "B").End(xlUp).Row
End If


If .Range("D" & r).Value <= 50000 And Range("K" & r).Value = "2017-18" Then
.Range("B" & r).Resize(, 11).Copy Destination:=Sheets("UPTO 50000 17-18").Range("B" & lr4 + 1)
lr4 = Sheets("UPTO 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
End If


If .Range("D" & r).Value > 50000 And Range("K" & r).Value = "2017-18" Then
.Range("B" & r).Resize(, 11).Copy Destination:=Sheets("ABOVE 50000 17-18").Range("B" & lr5 + 1)
lr5 = Sheets("ABOVE 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
End If


Next r
End With
End Sub

 

[manojrf]

It was my fault. I did not see the number that I had earlier entered in B100 and so it was being copied from row 1 to row 100. After I deleted it, it is working properly.

Anyway thanks.