tiffbeesknees
New Member
- Joined
- Jun 27, 2018
- Messages
- 2
I'm going to preface this with I essentially have Frankenstein'd some code together from googling since my VBA skills are very low. Here's what I'm trying to do: I want to go through multiple workbooks (saved in different locations), search a certain column for the word "fail", if it's there I want to copy the 3 cells to the left of the fail and paste that into the original workbook sheet 1. I also want to copy a static cell in each workbook next to what was just pasted into the original workbooks. I then want it to close the workbook I copied from and open the next one (i have about 30 files I need to do this from). I have all the file links in my original workbook currently (hence the "For i" part").
Anyway, I got it to partially work although it didn't continue through all workbooks. Then I messed with it some more and now i'm getting a "Next without For" error.
So any help... is greatly appreciated. thank you!
Anyway, I got it to partially work although it didn't continue through all workbooks. Then I messed with it some more and now i'm getting a "Next without For" error.
So any help... is greatly appreciated. thank you!
Code:
Sub Button2_Click()
Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook
For i = 7 To 38
With Workbooks.Open(Range("A" & i))
Set WB2 = ActiveWorkbook
Sheets("Tests").Select
Dim rngFound As Range
With ActiveSheet.Range("D1:D40")
Set rngFound = .Find(What:="Fail", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rngFound Is Nothing Then
rngFound.Offset(0, 3).Activate
Range(Cells(Selection.Row, 1), Cells(Selection.Row, 3)).Select
Selection.Copy
WB1.Activate
Sheets("Sheet1").Select
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
WB2.Activate
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
WB1.Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
WB2.Activate
ActiveWindow.Close
Next
End With
Application.ScreenUpdating = True
End Sub