Copy and paste columns based on cell value

[anissw]

Hi- I looked at other examples and tested, but I couldn't get it to work. I need to copy and paste the columns from Employees to Sheet1 based on cell value from my Users sheet. Please review my codeand tell me what I need to do. This code pastes all rows instead of the columns I need (columns A - F) only and it only pasted 1 row instead of all rows that met the criteria.

Thanks-

#Sub Import_EMP()
Sheets("Employees").Visible = True
Sheets("Employees").Unprotect ("jethro")
Sheets("Employees").Activate
Sheets("Users").Visible = True
Sheets("Users").Unprotect ("jethro")
Sheets("Users").Activate

Dim r As Integer
Dim i As Integer
r = 5
For i = Selection.Rows.Count + 1 To Step - 1
If Range("A" & i).Value = Sheets("Sheet1").Range("A2").Value Then
Range("A" & i).EntireRow.Copy Sheets("Sheet1").Cells(r, 1)
r = r + 1
End If
Next
'Sheets("Employees").Activate
'Sheets("Employees").Protect ("jethro")
End Sub#

 

[jai9]

Hi,

Try adding these lines to code.

Dim lr as Long
lr = Range("A1").End(xlDown).Row
For i = lr + 1 To 1 Step - 1

Jai

 

[anissw]

Hi Jai9. Thanks for replying. Unfortunately it didn't work. No data appeared on Sheet1. I can't understand, yesterday when I tested this, it worked by copying the entire rows over. I wanted to revised by only copying the columns over, but since I started this, nothing is copying over. It's like it's not reading the script anymore. Here's the revision I made based on your recommendations:

#Sub Import_EMP()
Sheets("Employees").Visible = True
Sheets("Employees").Unprotect ("jethro")
Sheets("Employees").Activate
Sheets("Users").Visible = True
Sheets("Users").Unprotect ("jethro")
Sheets("Users").Activate
Dim lr As Long
lr = Range("A1").End(xlDown).Row
Dim r As Integer
Dim i As Integer
r = 5
For i = lr + 1 To 1 Step -1
'For i = Selection.Rows.Count + 1 To Step - 1
If Range("A" & i).Value = Sheets("Sheet1").Range("A2").Value Then
Range("A" & i).EntireRow.Copy Sheets("Sheet1").Cells(r, 1)
r = r + 1
End If
Next
'Sheets("Employees").Activate
'Sheets("Employees").Protect ("jethro")
End Sub

 

[jai9]

Hi,

This code will check if Sheets("Sheet1").Range("A2").Value exists in column A of sheet Users and if found will copy the complete row.

There is no mention of copying entire column.

Logically, even if a matches are found and you copy entire column A, it would be same result always.

If you are looking to copy column, then you should be looking for a value in row and if found, copy the entire column.

Jai

 

[anissw]

Hi Jai9. You were right. I made changes to my code to conduct a autofilter in my script and set the criteria based on the site ID. Then did a copy and paste from Employees to Sheet1 and then turn off autofilter on Employees sheet. It worked perfectly!!

Again, thank you for your input. I was looking at this differently. Let me know if you are interested in reviewing my updated code.