August 24, 2020

Copying Rows between Workbooks Based on Text Value

How to copy rows of data from multiple workbooks based on keywords in worksheet cells into a master Workbook using the SPLIT function in VBA. Watch the video below:

Copying Rows between Workbooks

Here’s the complete VBA code:

Option Explicit
Function ClearClipboard()
Dim oData As Object
Set oData = CreateObject(“New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}”)
oData.SetText Text:=Empty
Set oData = Nothing
End Function

Sub copySpecificDataFromMultipleWorkbooks()
Call ClearClipboard
Dim myFile As String, path As String, mytext As String
Dim erow As Long, lastcolumn As Long, lastrow As Long, i As Long, lastcolumn2 As Long, x As Long
Dim mytextarr

path = “C:\test-data\”
myFile = Dir(path & “*.xlsx”)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Do While myFile <> “”
Workbooks.Open (path & myFile)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

For i = 2 To lastrow
mytext = Cells(i, 3)
mytextarr = Split(mytext, ” “) ‘123 456 abc xyz

For x = 0 To UBound(mytextarr)
If mytextarr(x) = “161-0045” Or mytextarr(x) = “KEYBOARD” Then
ActiveSheet.Range(Cells(i, 1), Cells(i, lastcolumn)).Copy

erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lastcolumn2 = Workbooks(“test1.xlsm”).Worksheets(“Sheet1”).Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Cells(erow, 1).Select
End If
Next x

Next i

Workbooks(myFile).Close savechanges:=False

myFile = Dir()

Call ClearClipboard
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Copying Rows of Data between Workbooks Based on Text Value

Further Reading:

Split Function