Copy sheets from one workbook to a new workbook!!

[Rayyan91]

Hello there,

I am trying to make a VBA code that copy specific sheets based on the selected cells and paste them into a new workbook.

For example , if cell(2,3) = China , copy sheet 2 and sheet 3. Then create a new workbook named China that has sheet 2 and 3 in it.

if Cell(2,3) = USA, copy sheet 5. Then create a new workbook named USA that has Sheet5.

i have wrote few lines of the code, but its only create a new workbook without the selected sheets and without the desired name, which is China or USA in this example.

Can someone please help me?

Sub Test()


Dim wbUser As Workbook: Set wbUser = ActiveWorkbook
Dim FolderName As String
Dim FolderPath As String
Dim FSupplier As String
Dim Supplier As String




FolderName = Cells(2, 3)
FolderPath = Application.ActiveWorkbook.Path
FSupplier = Cells(2, 3)
FolderPath = (FolderPath & "\" & FSupplier)


If Dir(FolderPath, vbDirectory) = "" Then
    MkDir FolderPath
End If


FolderName = (FolderPath & "\" & FolderName & ".xlsx")
Dim wbTarget As Workbook: Set wbTarget = ActiveWorkbook


Application.Workbooks.Add (xlWBATWorksheet)






wbUser.Activate


Sheets("User").Select


Supplier = Cells(2, 3)


Select Case Supplier
    Case "China"
        wbUser.Sheets(" Electrical Products").Copy After:=wbTarget.Sheets("Sheet1")
        wbUser.Sheets(" Other Products").Copy After:=wbTarget.Sheets("Sheet1")
    Case USA
        wbUser.Sheets(" Wood Products").Copy After:=wbTarget.Sheets("Sheet1")
    Case India


        
        
End Select


ActiveWorkbook.Save






End Sub

 

[Rayyan91]

Can someone please help?!

 

[Fluff]

Untested but try

Sub Test()

    Dim FolderPth As String
    Dim FileNme As String
    Dim Supplier As String
    
    FolderPth = (ActiveWorkbook.Path & "\" & Cells(2, 3))
    If Dir(FolderPth, vbDirectory) = "" Then
        MkDir FolderPth
    End If
    
    FileNme = (FolderPth & "\" & Cells(2, 3) & ".xlsx")
    
    With Sheets("User")
        Select Case Cells(2, 3)
            Case "China"
                Sheets(Array(" Electrical Products", " Other Products")).Copy
            Case "USA"
                Sheets(" Wood Products").Copy
            Case "India"
        
        
                
                
        End Select
    End With
    
    ActiveWorkbook.SaveAS FileNme, 51
    ActiveWorkbook.Close
    
End Sub

 

[Rayyan91]

Untested but try

Sub Test()

    Dim FolderPth As String
    Dim FileNme As String
    Dim Supplier As String
    
    FolderPth = (ActiveWorkbook.Path & "\" & Cells(2, 3))
    If Dir(FolderPth, vbDirectory) = "" Then
        MkDir FolderPth
    End If
    
    FileNme = (FolderPth & "\" & Cells(2, 3) & ".xlsx")
    
    With Sheets("User")
        Select Case Cells(2, 3)
            Case "China"
                Sheets(Array(" Electrical Products", " Other Products")).Copy
            Case "USA"
                Sheets(" Wood Products").Copy
            Case "India"
        
        
                
                
        End Select
    End With
    
    ActiveWorkbook.SaveAS FileNme, 51
    ActiveWorkbook.Close
    
End Sub

You the King of Chippenham. Thank you so much

 

[Fluff]

Glad to help & thanks for the feedback