VBA - Select multiple sheets/copy to new workbook

[vb_crazy]

Hi,

I need to select multiple sheets (based on the contents of a range of cells) and copy those sheets to a new workbook. Each cell in the range contains a sheet name that I need to export.

I have the code written almost to where I need it to be, but I can't get the macro to select all of the sheets, just cycles through them and select the last one (probably b/c I'm using a For...Next loop, I know). Any ideas would be really appreciated

Sub arrayTest()

Dim a As Variant
Dim sheetname As String

Sheets("Export").Select

For i = 5 To Range("D5").Value

sheet_name = Sheets("Export").Range("B" & i).Value
Application.SendKeys "+", True
Sheets(sheet_name).Select

Worksheets.Copy

Next i

End Sub

Thanks!
Pete

 

[Norie]

Pete

Why do you want to select the sheets?

You don't need to.

Where are you copying the sheets to?

Sub arrayTest()

Dim a As Variant
Dim sheetname As String

    Sheets("Export").Select
    
    For i = 5 To Range("D5").Value
    
        sheet_name = Sheets("Export").Range("B" & i).Value
        Sheets(sheet_name).Copy ' add the destination after here
    
    Next i

End Sub

 

[vb_crazy]

Hi - I need to select the sheets because there are over 60 sheets in the workbook and I only need to export 20-30 of them at a time.

the list of sheets I need to export changes each time, so I need to tie it to a range of cells instead of just specifying an array of sheets.

I just need to copy the sheets to a new workbook.

any assistance you can provide would be appreciated.

THANKS!

 

[frenkc1]

new Array Macro

you may try the following:

Sub testArray()

Dim myArray() As String
Dim myRange As Range
Dim Cell As Range
Dim OldBook As String
Dim newBook As String
Dim a As Long

Set myRange = Sheets(1).Range("B4:B6")      
'Or the range with  your sheetnames

OldBook = ActiveWorkbook.Name

For Each Cell In myRange
    If Not Cell = "" Then
        a = a + 1
        ReDim Preserve myArray(1 To a)
        myArray(a) = Cell
    End If
Next

For a = 1 To UBound(myArray)
    If a = 1 Then
        Sheets(myArray(a)).Copy
        newBook = ActiveWorkbook.Name
        Workbooks(OldBook).Activate
    Else
        Sheets(myArray(a)).Copy After:=Workbooks(newBook).Sheets(a - 1)
        Workbooks(OldBook).Activate
    End If
Next
End Sub

//This'll put your sheets in a new Workbook!

 

[vb_crazy]

It worked great!

WOW! I am thoroughly impressed. Your solution worked perfectly. Thanks for taking the time to respond and for the excellent solution.

Thanks, frenkc1!!!!!

 

[Norie]

How about this?

Sub CopySheets()
Dim wbOld As Workbook
Dim wbNew As Workbook
Dim rng As Range
Dim I As Long

    Set wbOld = ActiveWorkbook
    Set rng = wbOld.Sheets("Export").Range("B5:B" & wbOld.Sheets("Export").Range("D5").Value)

    wbOld.Sheets(rng.Cells(1, 1).Value).Copy

    Set wbNew = ActiveWorkbook
    
    For I = 2 To rng.Cells.Count
        wbOld.Sheets(rng.Cells(I, 1).Value).Copy After:=wbNew.Sheets(I - 1)
    Next I
    
End Sub

 

[vb_crazy]

thanks!

GREAT! thanks so much, Norie

 

[Syedabuthahir]

hi ,

please could you explain the following codes thanks in advance regards Syed

wbOld.Sheets(rng.Cells(1, 1).Value).Copy


wbOld.Sheets(rng.Cells(I, 1).Value).Copy After:=wbNew.Sheets(I - 1)
</pre>

 

[xceptional88]

hi ,

please could you explain the following codes thanks in advance regards Syed

wbOld.Sheets(rng.Cells(1, 1).Value).Copy


wbOld.Sheets(rng.Cells(I, 1).Value).Copy After:=wbNew.Sheets(I - 1)

Can you help me.

I have two sheets in a xlsm file.

Column A has limited rows but different each time. I want to identify the last filled column. Then select column B to Q to that number and paste that to new workbook sheet 1.

use the same logic to get from another sheet and stitch at the bottom of sheet1