Copy a range of cells in a row based on value in two cells and paste in different sheets

M

manojrf

Board Regular
Joined
Mar 28, 2011
Messages
109
Hello everyone,

In this forum, I found a macro to copy an entire row based on value and to paste in different sheets. First of all, let me say that I am not an expert in creating macros. I have made some modifications to the original one, added one more criteria.

Sub Copy()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("LIST").Cells(Rows.Count, "B").End(xlUp).Row
lr2 = Sheets("ABOVE 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
lr3 = Sheets("BELOW 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
For r = lr To 2 Step -1
If Range("E" & r).Value = "17-18" And Range("D" & r).Value >50000 Then
Rows(r).Copy Destination:=Sheets("ABOVE 50000 17-18").Range("B" & lr2 + 1)
lr2 = Sheets("ABOVE 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
End If
If Range("E" & r).Value = "17-18" And Range("D" & r).Value <50000 Then
Rows(r).Copy Destination:=Sheets("BELOW 50000 17-18").Range("B" & lr2 + 1)
lr2 = Sheets("BELOW 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
End If
Range("A1").Select
Next r
End Sub


When the macro was run, it used to copy the entire row and paste it to different sheets based on the conditions. It was working fine, until I changed Column A to Column B. In addition to this, I have put a formula in column A in the destination sheets. When I run the macro, it says that the copy area and paste area are not of the same size and so can't paste it. I have tried my best to make it work, but it isn't.

Instead of copying the entire row, can this be modified to copy a range of cells in a row, when the conditions are met ?

Can anyone please help me out ?

LIST

ABCDE
NumberNameAmountYear
ABCD17-18
BCDE17-18
CDEF17-18

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:41px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"></colgroup><tbody>
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]1[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]2[/TD]

[TD="align: right"]1234[/TD]

[TD="align: right"]51000[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]3[/TD]

[TD="align: right"]2345[/TD]

[TD="align: right"]45000[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]4[/TD]

[TD="align: right"]3456[/TD]

[TD="align: right"]1000[/TD]

</tbody>


Excel tables to the web >> Excel Jeanie HTML 4




ABOVE 50000 17-18

ABCDEF
Sr.NoNumberNameAmountYear

<tbody>
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]1[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]2[/TD]

[TD="align: right"]1[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]3[/TD]

[TD="align: right"]2[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]4[/TD]

[TD="align: right"]3[/TD]

</tbody>

Spreadsheet Formulas
CellFormula
A2=IF(B2="","",F2)
A3=IF(B3="","",F3)
A4=IF(B4="","",F4)

<tbody>
</tbody>

<tbody>
</tbody>




BELOW 50000 17-18

ABCDEF
Sr.NoNumberNameAmountYear

<tbody>
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]1[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]2[/TD]

[TD="align: right"]1[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]3[/TD]

[TD="align: right"]2[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]4[/TD]

[TD="align: right"]3[/TD]

</tbody>

Spreadsheet Formulas
CellFormula
A2=IF(B2="","",F2)
A3=IF(B3="","",F3)
A4=IF(B4="","",F4)

<tbody>
</tbody>

<tbody>
</tbody>




Thanks in advance.
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Sort by date Sort by votes
Try

Code: 
Sub Copy()
    Dim lr As Long, lr2 As Long, lr3 As Long, r As Long
    
    lr = Sheets("LIST").Cells(Rows.Count, "B").End(xlUp).Row
    lr2 = Sheets("ABOVE 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
    lr3 = Sheets("BELOW 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
    
    With Sheets("LIST")
        For r = 2 To lr
            If .Range("E" & r).Value = "17-18" And .Range("D" & r).Value > 50000 Then
                .Range("B" & r).Resize(, 4).Copy Destination:=Sheets("ABOVE 50000 17-18").Range("B" & lr2 + 1)
                lr2 = Sheets("ABOVE 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
            End If
            If .Range("E" & r).Value = "17-18" And .Range("D" & r).Value < 50000 Then
                .Range("B" & r).Resize(, 4).Copy Destination:=Sheets("BELOW 50000 17-18").Range("B" & lr3 + 1)
                lr3 = Sheets("BELOW 50000 17-18").Cells(Rows.Count, "B").End(xlUp).Row
            End If
        Next r
    End With
End Sub

Hope this helps

M.
 
Upvote 0
Hi there,

In continuation to my previous queries, I need one more help

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.

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

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Copying Rows Based on Column Value
Replies
1
Views
180
jolivanes
jolivanes
I
  • Solved
Listbox on userform to show results in reverse order
2
Replies
16
Views
351
Fuji
F
hardeep.kanwar
  • Question Question
Paste data based on cell color
Replies
2
Views
62
Peter_SSs
Peter_SSs
J
  • Question Question
A VBA Code to Transfer rows of cells across Sheets based on Certain Column Value
Replies
2
Views
261
Peter_SSs
Peter_SSs
C
  • Solved
VBA - Copy and paste a range of values N times
Replies
6
Views
440
cydmm
C

Forum statistics

Threads
1,224,823
Messages
6,181,179
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top