Macro To Pull Out a Search Item From One Book To Another
Sub SearchPull1()
Dim x As Integer
Dim Y As Integer
Dim Z As Integer
Dim A As Integer
Dim B As String
Dim c As String
A = 1
c = InputBox(" Enter Search String ")
B = InputBox(" Enter Work Book Name To Save ")
Workbooks.ADD.SaveAs Filename:=B
Workbooks.Open Filename:=B
Sheets.ADD.Name = c
For Z = 1 To 26
For x = 1 To 100
If InStr(LCase(Workbooks("A").Sheets("AAA").Cells(x, Z)), LCase(c)) Then
A = A + 1
For Y = 1 To 26
Workbooks(B).Sheets(c).Cells(A, Y) = Workbooks("A").Sheets("AAA").Cells(x, Y)
Workbooks(B).Sheets(c).Cells(1, Y) = Workbooks("A").Sheets("AAA").Cells(1, Y)
Cells(1, Y).Font.Bold = True
Next Y
End If
Next x
Next Z
Workbooks(B).SaveAs Filename:="D:\SAS\" & B
Workbooks(B).Close
End Sub
No comments:
Post a Comment
Hi User, Thank You for Visiting My Blog. Please Post Your Feedback/Comments/Query.