TheCobbler
New Member
- Joined
- Aug 21, 2021
- Messages
- 49
- Office Version
- 365
- Platform
- Windows
Hi again! Close to the point of giving up here and just doing things the long way. Rather than repeating the code I want to change my variables with a Loop. I've got around 14 books and different values that I want to open and copy data to based on a value in Column E. As below, If Column E contains 'ACTIVE' Then copy it to Workbook with "Path A", then If E contains BAR copy it to "Path B" etc. Any help much appreciated. Thanks!
VBA Code:
Option Explicit
Sub LoopHelp()
Application.ScreenUpdating = False
Dim Lastrow, NextRow, ThisValue As Variant
Dim X As Integer
Dim ThisWb, WbkA, WbkB, WbkC As Workbook
Set ThisWb = ThisWorkbook
Set WbkA = Workbooks.Open("C:\Users\Desktop\Array Test\Path A.xlsx")
Set WbkB = Workbooks.Open("C:\Users\Desktop\Array Test\Path B.xlsx")
Set WbkC = Workbooks.Open("C:\Users\Desktop\Array Test\Path C.xlsx")
ThisWb.Activate
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For X = 2 To Lastrow
ThisValue = Cells(X, 5).Value
If InStr(1, ThisValue, "ACTIVE") > 0 Then
Cells(X, 1).Resize(1, 33).Copy
WbkA.Activate
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
ThisWorkbook.Activate
End If
Next X
ThisWb.Activate
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For X = 2 To Lastrow
ThisValue = Cells(X, 5).Value
If InStr(1, ThisValue, "BAR") > 0 Then
Cells(X, 1).Resize(1, 33).Copy
WbkB.Activate
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
ThisWorkbook.Activate
End If
Next X
ThisWb.Activate
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For X = 2 To Lastrow
ThisValue = Cells(X, 5).Value
If InStr(1, ThisValue, "CIA") > 0 Then
Cells(X, 1).Resize(1, 33).Copy
WbkC.Activate
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
ThisWorkbook.Activate
End If
Next X
WbkA.Close True
WbkB.Close True
WbkC.Close True
Application.ScreenUpdating = True
End Sub