1819
10-22-2016, 02:13 PM
Thanks to help from forum colleagues, this macro works well to move rows to another worksheet if cells in column A contain that worksheet's name.
What I would like the macro to do now is to look into other workbooks (without having to open them) and continue to move rows to worksheets until all files in a particular folder have been checked.
So if you had:
A1 - bob sits in a swing
A2 - sam eats dinner
A3 - gill goes home
and you had in Folder A:
Workbook 1 - Sheet "bob"
Workbook 2 - Sheet "eats"
Workbook 3 - Sheet "home"
each row would be moved out to the corresponding worksheet. It's okay that a row gets moved out to the first sheet that matches.
The workbooks have the same structure but different worksheet names. There are no other files in Folder A.
I'd be very grateful for help.
Sub MoveToSheets()
Dim rr As Range, r As Range
Dim n As Long
Dim mySheet As String
Dim ws As Worksheet
mySheet = "Sheet1"
Set rr = Worksheets(mySheet).Cells(1).CurrentRegion
For Each ws In Worksheets
n = 1
If ws.Name <> mySheet Then
For Each r In rr.Rows
If InStr(r.Cells(1).Value, ws.Name) > 0 Then
n = n + 1
r.Copy ws.Cells(n, 1)
r.ClearContents
End If
Next
End If
Next
Cells.Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A30000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:E30000")
'would be good to replace this range with find all used rows instead
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
What I would like the macro to do now is to look into other workbooks (without having to open them) and continue to move rows to worksheets until all files in a particular folder have been checked.
So if you had:
A1 - bob sits in a swing
A2 - sam eats dinner
A3 - gill goes home
and you had in Folder A:
Workbook 1 - Sheet "bob"
Workbook 2 - Sheet "eats"
Workbook 3 - Sheet "home"
each row would be moved out to the corresponding worksheet. It's okay that a row gets moved out to the first sheet that matches.
The workbooks have the same structure but different worksheet names. There are no other files in Folder A.
I'd be very grateful for help.
Sub MoveToSheets()
Dim rr As Range, r As Range
Dim n As Long
Dim mySheet As String
Dim ws As Worksheet
mySheet = "Sheet1"
Set rr = Worksheets(mySheet).Cells(1).CurrentRegion
For Each ws In Worksheets
n = 1
If ws.Name <> mySheet Then
For Each r In rr.Rows
If InStr(r.Cells(1).Value, ws.Name) > 0 Then
n = n + 1
r.Copy ws.Cells(n, 1)
r.ClearContents
End If
Next
End If
Next
Cells.Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A30000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:E30000")
'would be good to replace this range with find all used rows instead
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub