1

I am trying to write a macro that copies a row if a cell in that row contains text (For ex: Mumbai, Delhi etc) from Column C.

For example if there are 30 rows but only 15 contains text(Mumbai & Delhi) in column C. I want to copy those 15 rows and paste them into "Sheet2" I was using the below code. however it is copying all the filled rows. however my requirement is the code should only need to copy columns of a, b, c, d, f, g, h, i, l & m to Sheet2.

 Sub testPasteinSh2() Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range Dim rngCopy As Range, lastR1 As Long, lastR2 As Long Dim strSearch1 As String, strSearch2 As String strSearch1 = "Mumbai" 'or combo value... strSearch2 = "Delhi" 'or something else... Set sh1 = ActiveSheet 'use here your worksheet Set sh2 = Worksheets("Sheet2") 'use here your sheet lastR1 = sh1.Range("C" & Rows.count).End(xlUp).Row lastR2 = sh2.Range("A" & Rows.count).End(xlUp).Row + 1 Set rng = sh1.Range("C2:C" & lastR1) For Each cel In rng.cells If cel.Value = strSearch1 Or cel.Value = strSearch2 Then If rngCopy Is Nothing Then Set rngCopy = sh1.Rows(cel.Row) Else Set rngCopy = Union(rngCopy, sh1.Rows(cel.Row)) End If End If Next If Not rngCopy Is Nothing Then rngCopy.Copy Destination:=sh2.cells(lastR2, 1) End If End Sub

Can you please help me. Thank you in Advance.

Improve this question
3
  • Your actual code copies just 1 cell, but in your question you say ...a macro that copies a row .... Please, specify if row of data or single cell Commented Aug 14, 2020 at 14:05
  • a, b, c, d, f, g, h, i, l & m to Sheet2 Ok, but you want to paste them in same columns? that would leave blanks... Or should they be pasted one after another? Commented Aug 14, 2020 at 14:34
  • The above code is working fine and it is not leaving any blanks between columns. On my original data column D has blank cells. Column D cell values are available in column H as zero or 1 or 2 etc. I want the code should' copy the rows of value more than zero in column H. Commented Aug 14, 2020 at 15:49

2 Answers 2

Reset to default
1

It looks difficult to ask a clear question...

It happens I know what you need from a previous question. Supposing that you did not change your mind, please test the next code:

Sub testPasteinSh2Bis() Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range Dim rngCopy As Range, lastR1 As Long, lastR2 As Long Dim strSearch1 As String, strSearch2 As String 'a, b, c, d, f, g, h, i, l 'columns to be copied strSearch1 = "Mumbai" 'or combo value... strSearch2 = "Delhi" 'or something else... Set sh1 = ActiveSheet 'use here your worksheet Set sh2 = sh1.Next 'use here your sheet lastR1 = sh1.Range("C" & Rows.count).End(xlUp).Row lastR2 = sh2.Range("A" & Rows.count).End(xlUp).Row + 1 Set rng = sh1.Range("C2:C" & lastR1) For Each cel In rng.cells If cel.Value = strSearch1 Or cel.Value = strSearch2 Then If rngCopy Is Nothing Then Set rngCopy = sh1.Range(sh1.Range("A" & cel.Row & ":D" & cel.Row).Address & "," & _ sh1.Range("F" & cel.Row & ":I" & cel.Row).Address & "," & sh1.Range("L" & cel.Row).Address) Else Set rngCopy = Union(rngCopy, sh1.Range(sh1.Range("A" & cel.Row & ":D" & cel.Row).Address & "," & _ sh1.Range("F" & cel.Row & ":I" & cel.Row).Address & "," & sh1.Range("L" & cel.Row).Address)) End If End If Next If Not rngCopy Is Nothing Then rngCopy.Copy Destination:=sh2.cells(lastR2, 1) End If End Sub

It should copy the columns a, b, c, d, f, g, h, i, l for the matching cases...

Improve this answer
Sign up to request clarification or add additional context in comments.

5 Comments

Thank you much for helping me with this query. It saves so much time for me on my regular work. need further assistance please. Everytime when i get the data there were few empty cells will be there in column D. Column D cells values are listed in H as zero. however, sometimes will receive a value(number not zero) in column H for columnd D empty cells. Can it be possible to modify the code which can not copy empty rows of value zero.
@Shalini Reddy: I do not understand what you are saying. All values from column D:D of the first sheet are copied in column D:D of the second one. What does " not copy empty rows of value zero" should mean? None of the empty rows will be copied! The code copies only the requested range (a, b, c, d, f, g, h, i columns) if in the specific row, a search word is found. So, it cannot be empty. Then, did you say anything in your question about some empty rows, and what this emptiness would mean?
Thanks for help! Second code answered my question. @FaneDuru
@Shalini Reddy: OK. Now, what does the code, even answering your question, but not convenient for you and it should be improved? But try clearly explaining the issue... If it only a detail, I will adapt the code. If it changes the question meaning, you should place another question, I am afraid. These are the community rules...
The above code is perfectly works fine for this question. Also, your previous code answered the previous question. If i have any further help or modification needed in this code will raise new request. Thank you again @FaneDuru
0

You could try this:

Sub Macro1() Dim lastrow As Long, erow As Long Dim rng1 As Range Dim rng2 As Range 'choose an empty column, in my example is O. With Worksheets("Sheet1") lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row .Range("O2:O" & lastrow).FormulaR1C1 = "=IF(OR(RC[-12]=""Mumbai"",RC[-12]=""Delhi""),1,"""")" 'here is -12 because difference between column C and O is 3. Change it according your needs Set rng1 = .Range("O2:O" & lastrow).SpecialCells(xlCellTypeFormulas, 1) For Each rng2 In rng1.Cells erow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row Worksheets("Sheet2").Range("A" & erow + 1 & ":M" & erow + 1) = .Range("A" & rng2.Row & ":M" & rng2.Row).Value 'this will copy the full row of data from A to M Next rng2 Set rng1 = Nothing .Range("O2:O" & lastrow).Clear End With 'delete the columns copied but you don't want like E, J,K With Worksheets("Sheet2") .Columns("E:E").Delete .Columns("J:K").Delete End With End Sub

This code will copy the row of data and delete the columns you don't want.

In case that's not posible, then you can copy single ranges. You could replace line

Worksheets("Sheet2").Range("A" & erow + 1 & ":M" & erow + 1) = .Range("A" & rng2.Row & ":M" & rng2.Row).Value 'this will copy the full row of data from A to M

with

Worksheets("Sheet2").Range("A" & erow + 1).Value = .Range("A" & rng2.Row).Value 'a single cell

Probably you can adapt this to your needs.

enter image description here

Improve this answer

1 Comment

I want to add column headers to the copied rows. Could you please help suggest me the code. I tried Activesheet(sh1).Range("A6").Copy _ Worksheets("Sheet1").Range("A1") but it didn't worked out

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.