jlw8201
08-28-2019, 10:04 AM
Hello,
Here is what I am trying to accomplish:
Workbook with 3 tabs. "Data", "Names", and "Results".
I want to copy rows of data from the "Data" tab into the "Results" tab. I only want data copied IF there is a matching name on the "Names" tab that is also in the "Data" tab. I have found a macro that will copy the data to the "Results" tab, but only by typing in one name at a time into the code.
How can i search for data and copy it based on names in another worksheet?
I am using Excel 2013
"Names" tab: Names i want to search by are located in column B
"Data" tab: Names i want to match are also located in column B. If the names match, i want to copy the whole row. And there may be more than 1 row with the same name. I want to copy all rows with the matching name. Data extends from columns A:G.
"Results" tab: Data should start on A2.
Thank you in advance for any help, i truly appreciate it!
Here is the Code: (I am just learning, and i appreciate any guidance. This code was copied and adapted from other examples i could find!)
Sub copyToOtherSheet()
Dim srcSheet As Worksheet, dstSheet As Worksheet
Dim lRow As Long
Dim srcRng As Range
' Don't display alert on deletion
Application.DisplayAlerts = True
With ThisWorkbook
' Sheet where we copy from
Set srcSheet = .Sheets("Data")
' Sheet where we copy to
Set dstSheet = .Sheets("Results")
End With
With srcSheet
' Check how many records in table
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
' Filter all values with "textvalue" in column B
.Rows(1).AutoFilter 2, "NAME"
' Set copy range
Set srcRng = .Range(.Cells(7, 1), .Cells(lRow, 7))
' Copy visible rows
On Error Resume Next
srcRng.SpecialCells(xlCellTypeVisible).Copy
' If we don't have anything to copy, exit macro
If Err.Number = 1004 Then
MsgBox "No cells to copy!" & vbNewLine & "Exiting macro.", vbInformation
srcSheet.ShowAllData
Application.DisplayAlerts = True
End
End If
On Error GoTo 0
End With
With dstSheet
' Check how many records in already in table
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
' Paste records to destionation table
.Cells(lRow + 1, 1).PasteSpecial
End With
' Clear filter
srcSheet.ShowAllData
Application.DisplayAlerts = True
End Sub
Here is what I am trying to accomplish:
Workbook with 3 tabs. "Data", "Names", and "Results".
I want to copy rows of data from the "Data" tab into the "Results" tab. I only want data copied IF there is a matching name on the "Names" tab that is also in the "Data" tab. I have found a macro that will copy the data to the "Results" tab, but only by typing in one name at a time into the code.
How can i search for data and copy it based on names in another worksheet?
I am using Excel 2013
"Names" tab: Names i want to search by are located in column B
"Data" tab: Names i want to match are also located in column B. If the names match, i want to copy the whole row. And there may be more than 1 row with the same name. I want to copy all rows with the matching name. Data extends from columns A:G.
"Results" tab: Data should start on A2.
Thank you in advance for any help, i truly appreciate it!
Here is the Code: (I am just learning, and i appreciate any guidance. This code was copied and adapted from other examples i could find!)
Sub copyToOtherSheet()
Dim srcSheet As Worksheet, dstSheet As Worksheet
Dim lRow As Long
Dim srcRng As Range
' Don't display alert on deletion
Application.DisplayAlerts = True
With ThisWorkbook
' Sheet where we copy from
Set srcSheet = .Sheets("Data")
' Sheet where we copy to
Set dstSheet = .Sheets("Results")
End With
With srcSheet
' Check how many records in table
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
' Filter all values with "textvalue" in column B
.Rows(1).AutoFilter 2, "NAME"
' Set copy range
Set srcRng = .Range(.Cells(7, 1), .Cells(lRow, 7))
' Copy visible rows
On Error Resume Next
srcRng.SpecialCells(xlCellTypeVisible).Copy
' If we don't have anything to copy, exit macro
If Err.Number = 1004 Then
MsgBox "No cells to copy!" & vbNewLine & "Exiting macro.", vbInformation
srcSheet.ShowAllData
Application.DisplayAlerts = True
End
End If
On Error GoTo 0
End With
With dstSheet
' Check how many records in already in table
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
' Paste records to destionation table
.Cells(lRow + 1, 1).PasteSpecial
End With
' Clear filter
srcSheet.ShowAllData
Application.DisplayAlerts = True
End Sub