VBA Copy paste columns in different sheet

I have two sheets – sheet 1, sheet 2. I need to copy col M from sheet 1 and paste it into col D of sheet 2 only if sheet 1 col A has the string “COMPATIBLE” and col B has the string “Pass”. Example: Sheet 1:

A                                               B                                            M

COMPATIBLE                 Fail                                          1

NON COMPATIBLE   PASS                                       2

COMPATIBLE               PASS                                       3

COMPATIBLE               PASS                                       4

 

Now in sheet 2 “D” col the value of M should be pasted: i.e:

D

3

4

Top Contributor Asked on January 11, 2017 in VBA: General.
Add Comment
7 Answer(s)

I found the answer. Thanks 🙂

Dim lRow As Integer, i As Integer, j As Integer
Dim ws1, ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Latency")
Set ws2 = ThisWorkbook.Sheets("TP")
'Find last roe in Sheet1
lRow = ws1.Cells.SpecialCells(xlLastCell).Row
j = 2
For i = 1 To lRow
If ws1.Range("E" & i) = "COMPATIBLE" And ws1.Range("O" & i) = "Pass" Then
Top Contributor Answered on January 12, 2017.
Add Comment

HI,

Here is the solution for your query to copy data from sheet1(Column ‘M’) to sheet2(Column ‘D’).

Sub sbMoveData()
Dim lRow As Integer, i As Integer, j As Integer
'Find last roe in Sheet1
lRow = Sheet1.Cells.SpecialCells(xlLastCell).Row
j = 1
For i = 1 To lRow
If UCase(Sheet1.Range("A" & i)) = "COMPATIBLE" And UCase(Sheet1.Range("B" & i)) = "PASS" Then
Sheets("Sheet1").Range("M" & i).Copy Destination:=Sheets("Sheet2").Range("A" & j)
j = j + 1
End If
Next
End Sub

 

Thanks!

Expert Answered on January 11, 2017.
Add Comment

Here is link to find some useful information related to your query.

http://analysistabs.com/excel-vba/copy-data-from-one-worksheet-to-another/

Thanks!

Expert Answered on January 11, 2017.
Add Comment

Thank you so much! Just a small doubt, how do I use col name here to search here instead of col range?

Example, if ColA is named as Column A and ColB is named as Column B , how do I modify this to make sure the code searches for the particular text if the col name matches  Column A and Column B?

Top Contributor Answered on January 12, 2017.
Add Comment

Hi I tried the code and it was throwing up an error message  – “Object required”

Repleaced sheet1 with Latency and sheet2 with TP

This is the code I used:

Sub sbMoveData()
Dim lRow As Integer, i As Integer, j As Integer
'Find last roe in Sheet1
lRow = Latency.Cells.SpecialCells(xlLastCell).Row
j = 1
For i = 1 To lRow
If UCase(Latency.Range("E" & i)) = "COMPATIBLE" And UCase(Latency.Range("O" & i)) = "Pass" Then
Sheets("Latency").Range("M" & i).Copy Destination:=Sheets("TP").Range("A" & j)
j = j + 1
End If
Next
End Sub
Top Contributor Answered on January 12, 2017.
Add Comment

I found my error and fixed the code to this:

Sub sbMoveData()
Dim lRow As Integer, i As Integer, j As Integer
'Find last roe in Sheet1
With Worksheets("Latency")
lRow = .Cells.SpecialCells(xlLastCell).Row
j = 1
For i = 1 To lRow
If UCase(.Range("E" & i)) = "COMPATIBLE" And UCase(.Range("O" & i)) = "Pass" Then
.Range("M" & i).Copy Destination:=Worksheets("TP").Range("D" & j)
j = j + 1
End If
Next
End With
End Sub

 

But I”m not getting any result 🙁

Top Contributor Answered on January 12, 2017.
Add Comment

Here is how I did it.

 

 
Sub pastedifferentsheets()
' excel 2010
' paste Columns in different sheets
Dim lRow As Integer
Dim i As Integer
lRow = [sheet1!H1] ' Sheet1 H1 (=Count(A:A)) so column A must contain contiguous data
i = 1
Application.ScreenUpdating = False
[a1].Select
Do Until i > lRow
If ActiveCell.Value = "Compatible" Then
ActiveCell.Offset(0, 1).Select
If ActiveCell.Value = "Pass" Then
ActiveCell.Offset(0, 1).Copy
Sheets("Sheet2").Select
[D1].Select
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
ActiveCell.Offset(-1, 0).Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If
End If
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
ActiveCell.Offset(0, -1).Select
End If
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop
Application.CutCopyMode = False 'gets rid of rubberband lines
ActiveWorkbook.Save ' this will save your work
End Sub
Top Contributor Answered on January 29, 2017.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.