简体   繁体   中英

How do I select multiple worksheets to move based on cell content?

I have google searched to no avail.

I need a code that will select multiple worksheets and move to a new book based on the contents of each worksheets cell(1,8). For example, all worksheets that contain "fin Ops" in cell (1,8) are moved to book1 and then all worksheets that contain "Re" in cell (1,8) are moved to book2.

I tried to start with the code below, but being a beginner is a bit tough:

Dim ws As Worksheet


For Each ws In ActiveWorkbook.Worksheets

 If ws.Cells(1, 8).Value = "Fin Ops" Then
 ActiveSheet.Select
End If

Next ws

Any help is greatly appreciated!!

You're actually on the right track! You have the correct idea using a for-each loop to go through all of the worksheets.

What you will want to do prior to this is create a few Workbook objects that will be the workbooks you wish to move these sheets to. You can do this like so:

Dim oBookOne As Workbook
Set oBookOne = Application.Workbooks("<workbook name here>")

Repeating that for all of the books required. Once you create all of your workbook objects, within your For-each loop you can do this:

For Each ws In ActiveWorkbook.Worksheets

  If ws.Cells(1, 8).Value = "Fin Ops" Then
     ws.Move After:= oBookOne.Sheets(oBookOne.Sheets.Count)
  End If

Next ws

Repeat that for every criteria you need to filter and it should work!

If you need further help, Google is your best friend. Here is documentation on how workbook objects work (heh) and here is the documentation on the Move function.

Code:

Sub SelectMove()
    Dim ws As String
    Dim arr() As String
    Dim w As Worksheet
    Dim c As Long

    c = 0

    For Each w In ActiveWorkbook.Worksheets
        If w.Cells(1, 8) = "Fin Ops" Then
            ws = ws & "," & w.Name
        End If
    Next

    ws = Right(ws, Len(ws) - 1)

    arr() = Split(ws, ",")

    Sheets(arr).Move
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM