Hello - I am working on a workbook that has a list of employee names in a column and a separate workbook that has assessment data in each row. I want to write a macro that uses checks for a name on the list from workbook A in workbook B and if it finds the data copy the entire row into a sheet in workbook A. It then needs to go onto the next name from the list in Workbook A and recheck workbook b for the new name and so on until all the names have been checked. I am not sure what is the best way to do this. Would it be a loop, or an array or something else I am not thinking about.
I have worked out the macro to run if I type the name in the macro, but not how to run from a separate list. Below is the code. I am new to VBA and I know I have to clean it up, but wanted to get everything running first.
Sub CopyDataVariant()
Dim cell As Range
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim S3 As Worksheet
Dim W1 As Workbook
Dim W2 As Workbook
Dim wbname As String
wbname = ThisWorkbook.Sheets("Main").Range("C4").Value
Set W1 = Workbooks(wbname)
Set S1 = W1.Sheets("Results")
Set W2 = Workbooks("QA Auto Worksheet.xlsm")
Set S2 = W2.Sheets("Transpose")
Set S3 = W2.Sheets("Data In")
For Each cell In S1.Range("H:H")
If cell.Value = "Jill Ford" Then
cell.EntireRow.Copy
S3.Select
S3.Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
End If
Next
S3.Range("A1:BB10").Copy
S2.Range("B1").PasteSpecial Transpose:=True
S2.Activate
With Selection
.ColumnWidth = 40
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Rows("1:7").Select
Selection.EntireRow.Hidden = True
Rows("9:18").Select
Selection.EntireRow.Hidden = True
Rows("21:21").Select
Selection.EntireRow.Hidden = True
Rows("41:42").Select
Selection.EntireRow.Hidden = True
S3.Range("A1:GG37").ClearContents
W2.Sheets("Main").Select
Range("A2").Select
End Sub
Any help would be greatly appreciated.
I have worked out the macro to run if I type the name in the macro, but not how to run from a separate list. Below is the code. I am new to VBA and I know I have to clean it up, but wanted to get everything running first.
Sub CopyDataVariant()
Dim cell As Range
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim S3 As Worksheet
Dim W1 As Workbook
Dim W2 As Workbook
Dim wbname As String
wbname = ThisWorkbook.Sheets("Main").Range("C4").Value
Set W1 = Workbooks(wbname)
Set S1 = W1.Sheets("Results")
Set W2 = Workbooks("QA Auto Worksheet.xlsm")
Set S2 = W2.Sheets("Transpose")
Set S3 = W2.Sheets("Data In")
For Each cell In S1.Range("H:H")
If cell.Value = "Jill Ford" Then
cell.EntireRow.Copy
S3.Select
S3.Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
End If
Next
S3.Range("A1:BB10").Copy
S2.Range("B1").PasteSpecial Transpose:=True
S2.Activate
With Selection
.ColumnWidth = 40
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Rows("1:7").Select
Selection.EntireRow.Hidden = True
Rows("9:18").Select
Selection.EntireRow.Hidden = True
Rows("21:21").Select
Selection.EntireRow.Hidden = True
Rows("41:42").Select
Selection.EntireRow.Hidden = True
S3.Range("A1:GG37").ClearContents
W2.Sheets("Main").Select
Range("A2").Select
End Sub
Any help would be greatly appreciated.