PDA

View Full Version : Change macro to move rows to worksheets in all workbooks in a folder



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

snb
10-23-2016, 02:15 AM
You should not use VBA Code you do not understand.
If you understand the code you are using now you must be able to adapt it to the new requirement.
This kind of fora is not meant to provide turn key VBA solutions, but to offer help to improve your abilities to create your own.

1819
10-23-2016, 05:00 AM
Thanks for being so helpful snb. It's really great when people take time to post such informative replies.

mana
10-23-2016, 06:09 AM
I don't understand,


1)each book in folder A has always one sheet only?
2)count of row should be moved is always one for each sheet?
3)mySheet = "Sheet1" exists in another book?


Anyway, I think you can use the Dir function.
Please try.

1819
10-23-2016, 10:11 AM
I don't understand,


1)each book in folder A has always one sheet only? No, the number of sheets varies.
2)count of row should be moved is always one for each sheet? No, that can vary too.
3)mySheet = "Sheet1" exists in another book? No.


Anyway, I think you can use the Dir function.
Please try.

Thank you for replying. I have answered your questions above. I will look into the Dir function. Thanks.