• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA CODE to move sheets based on the list

A

Arpanakumar

Member
Hello Experts team.

i have some requirment where in on click of a button need to move sheets and save it as separate workbooks with specific sheets..i do not want hard coded names it may vary..

Example

File Name Sheet names
FIRST A AA AAA
SECOND B BB BBB
THIRD C


Firstname file to be created with "A" "AA" "AAA" sheets from the master file and so on in a folder.


Please do need full test file attatched
 

Attachments

  • Test_File.xlsm
    11.5 KB · Views: 12
Arpanakumar said:
i do not want hard coded names it may vary..
Click to expand...

What do you mean by "hard coded names"?

Code: 
Sub test()
    Dim ws As Worksheet, e, n As Long, flg As Boolean
    For Each e In Array("A", "B", "C")
        For Each ws In Worksheets
            If ws.Name Like e & "*" Then
                ws.Select Not flg
                flg = True
            End If
        Next
        If flg Then
            n = n + 1
            ActiveWindow.SelectedSheets.Copy
            With ActiveWorkbook
                .SaveAs ThisWorkbook.Path & "\" & Choose(n, "FIRST", "SECOND", "THIRD") & ".xlsx"
                .Close False
            End With
        End If
        flg = False
    Next
End Sub
 
jindon said:
What do you mean by "hard coded names"?

Code: 
Sub test()
    Dim ws As Worksheet, e, n As Long, flg As Boolean
    For Each e In Array("A", "B", "C")
        For Each ws In Worksheets
            If ws.Name Like e & "*" Then
                ws.Select Not flg
                flg = True
            End If
        Next
        If flg Then
            n = n + 1
            ActiveWindow.SelectedSheets.Copy
            With ActiveWorkbook
                .SaveAs ThisWorkbook.Path & "\" & Choose(n, "FIRST", "SECOND", "THIRD") & ".xlsx"
                .Close False
            End With
        End If
        flg = False
    Next
End Sub
Click to expand...
Genius
 
Hey thank you so very much.

I meen hardcoard meen...in palace of "A" ,"AA" ,"AAA" sheet name it could be anything tomorrow...So macro should be dynamic.

and under each workbook like "FIRST", "SECOND","THIRED" sheet name while moving should refere to the master book and create it accordingly.


Example

File Name Sheet names
FIRST A AA C
SECOND B CC BBB
THIRD C ,AA



jindon said:
What do you mean by "hard coded names"?

Code: 
Sub test()
    Dim ws As Worksheet, e, n As Long, flg As Boolean
    For Each e In Array("A", "B", "C")
        For Each ws In Worksheets
            If ws.Name Like e & "*" Then
                ws.Select Not flg
                flg = True
            End If
        Next
        If flg Then
            n = n + 1
            ActiveWindow.SelectedSheets.Copy
            With ActiveWorkbook
                .SaveAs ThisWorkbook.Path & "\" & Choose(n, "FIRST", "SECOND", "THIRD") & ".xlsx"
                .Close False
            End With
        End If
        flg = False
    Next
End Sub
Click to expand...
 
So the list is in master sheet.
Code: 
Sub test()
    Dim r As Range, x
    Application.ScreenUpdating = False
    For Each r In Sheets("main sheet").[b3].CurrentRegion.Columns(1).Cells
        x = Filter(r.Parent.Evaluate("if(" & r(, 2).Resize(, 100).Address & _
            "<>""""," & r(, 2).Resize(, 100).Address & ")"), False, 0)
        If UBound(x) > -1 Then
            Sheets(x).Copy
            With ActiveWorkbook
                .SaveAs ThisWorkbook.Path & "\" & r.Value & ".xlsx"
                .Close False
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub[code]
 
You are not Genius at all ...You are a star( Excel vba Guru).
You deserve a Like.
Code works like a magic..God bless you.
 
jindon

Thanks ones again your code works, but need to handle some thing important.

when moving the sheets to new workbook, need to check if the sheets are exiting, other wise showing as error..there are chances where the sheet is not existing and we are trying to move.

Please need your help!
 
Thank you Marc for responding, i have checked the link referred but how to include in my code.

My first sheet contains format as below, which is working fine as per jindon provided the code.
But i wanted to ensure before it runs the code wanted to check if these sheets are really existing, other wise my code will through error.


File Name Sheet names
FIRST A AA C
SECOND B CC BBB
THIRD C , AA

Code provided by Jindon
Code: 
Sub test()
    Dim r As Range, x
    Application.ScreenUpdating = False
    For Each r In Sheets("main sheet").[b3].CurrentRegion.Columns(1).Cells
        x = Filter(r.Parent.Evaluate("if(" & r(, 2).Resize(, 100).Address & _
            "<>""""," & r(, 2).Resize(, 100).Address & ")"), False, 0)
        If UBound(x) > -1 Then
            Sheets(x).Copy
            With ActiveWorkbook
                .SaveAs ThisWorkbook.Path & "\" & r.Value & ".xlsx"
                .Close False
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub[code]

Please kindly help.
 
Try this demonstration :​
Code: 
Sub Demo()
    Dim VA, S$(), R&, C&
        VA = Worksheets(1).[B3].CurrentRegion.Value
        ReDim S(1 To UBound(VA))
    For R = 1 To UBound(VA)
        For C = 2 To UBound(VA, 2)
            If VA(R, C) > "" Then
                If Evaluate("ISREF('" & VA(R, C) & "'!A1)") Then
                    S(R) = S(R) & IIf(S(R) > "", "¤", "") & VA(R, C)
                Else
                    MsgBox VA(R, C) & "  :  invalid worksheet name", vbExclamation, " Operation aborted !"
                    Exit Sub
                End If
            End If
        Next
    Next
        Application.ScreenUpdating = False
    For R = 1 To UBound(VA)
        If S(R) > "" Then
            Worksheets(Split(S(R), "¤")).Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & VA(R, 1), 51
            ActiveWorkbook.Close False
        End If
    Next
        Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​
 
Yes, it works, but if two sheets does not exist shows message box only onces message..But still i can live with this..as need to re run the code to see if any other sheets exists.

Thanks Mark.
 


So you can easily mod the code using a specific String variable
for no-existing worksheets …

​
 
Mark.

I did't get you.
My idea is when showing msgbox should show which sheets not existing in a single go.

Example:

Sheets "A" & "AA" not existing.
 

Use a variable to store the no-existing worksheets …

At end of loop, if the variable is not empty so you can use MsgBox
to display names …
​
 
You must log in or register to reply here.
Back
Top