Change macro to move rows to worksheets in all workbooks in a folder

[1819]

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]

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]

Thanks for being so helpful snb. It's really great when people take time to post such informative replies.

[mana]

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]

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.