I read all the threads related to this topic and learned a lot but I'm still having a problem with my code. It's looping infinitely (not sure I did the loop right - well obv not if it doesn't stop looping, oy) and I can't seem to make it copy the data I want it to copy from the data dump worksheet for searching on the master. I am hoping someone can help.
I have a worksheet with a data dump (test). Column J contains a part number. I need to match this part number to the master worksheet (test-data), copy that row's data from columns AN through BO, and paste the copied data back to the data dump worksheet. Then I need it to move down one row, and repeat, until it encounters a blank field. Totally new to VBA and coding in general (this is my first try). What am I doing wrong?
Sub Macro4()
'
' Macro4 Macro 1201pm
'
Dim BlankFound As Boolean
Dim x As Long
Dim srcWks As Excel.Worksheet
Dim destWks As Excel.Worksheet
Dim Findtext As String
Set srcWks = Workbooks("test.xlsm").Worksheets("Sheet1")
'Source sheet
Set destWks = Workbooks("test-data.xlsx").Worksheets("Sheet1")
'Destination sheet
'Loop until a blank cell is found in Column
Do While BlankFound = False
x = x + 1
If Cells(x, "J").Value = "" Then
BlankFound = True
End If
'find data to search for
Windows("test.xlsm").Activate
Sheets("Sheet1").Select
Findtext = ActiveCell.Value
'move to second worksheet and search for this data
Windows("test-data.xlsx").Activate
Columns("AN:AN").Select
Selection.Find(What:=Findtext, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'copy range associated with the find results
Range("AN:BO").Select
Application.CutCopyMode = False
Selection.Copy
'paste range associated with the find results into first worksheet
Windows("test.xlsm").Activate
Sheets("Sheet1").Select
Range("AN:BO").Select
ActiveSheet.Paste
'Move down one cell
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Loop
'Report when done
MsgBox "Cell J" & x & " is blank! Processing completed."
End Sub
Display More