PDA

View Full Version : VBA to export 2 worksheets at a time



preseb
02-14-2011, 10:44 AM
can some assist in editting this macro so that is creates a copy of 5th & 6th worksheets together - all the way to the last worksheet.

so if I have a workbook that has 12 worksheets, 5&6 would be copied and saved as a workbook. 7&8, 9&10, 11&12.
I won't always have 12 worksheets, that is why I need it to go to the end.

thanks


Sub exportDirws()
Dim i As Long
Dim NewWks As Worksheet

For i = 5 To ActiveWorkbook.Worksheets.Count
Sheets(i).Copy 'to new workbook
Set NewWks = ActiveSheet
With NewWks.Parent
Application.DisplayAlerts = False
.Saveas Filename:="F:\Macros\" & NewWks.Name & ".xls", FileFormat:=56
Application.DisplayAlerts = True
.Close SaveChanges:=False
End With
Next i
MsgBox "Done!"
End Sub

mdmackillop
02-14-2011, 11:21 AM
Something like this

Sub Pairs()
Dim arr(1), i
For i = 1 To Sheets.Count Step 2
arr(0) = Sheets(i).Name
arr(1) = Sheets(i+1).Name
Sheets(arr).Copy
ChDir "C:\aaa"
With ActiveWorkbook
.SaveAs Filename:="NewBook" & i & ".xls", FileFormat:=xlNormal
.Close
End With
Next
End Sub

preseb
02-14-2011, 11:30 AM
mdmackillop - thank you for your reply.

The vba you provided it close.

It is keeping sheet 2 from the original workbook to new workbook and for the second sheet, it skips everyother worksheet in the original.

Also, I was hoping to start at worksheet 5.

thanks

mdmackillop
02-14-2011, 11:38 AM
There was a typo in my original post (now corrected). Change this line to start at Sheet 5

For i = 5 To Sheets.Count Step 2

preseb
02-14-2011, 11:45 AM
perfect - I did not see your other change of arr(1) = Sheets(2).Name
to arr(1) = Sheets(i+1).Name
I was wondering why I kept getting the same results - thanks for your help

preseb
02-14-2011, 11:58 AM
mdmackillop - may I add one other thing?
I am trying to save the file name as the name of the first worksheet and what is in worksheets(2) cell A3.
for the first part and I trying to use i.name but that is not working.
would you be able to assist with this? Thank you

mdmackillop
02-14-2011, 12:44 PM
Sub Pairs()
Dim arr(1), i Dim Nm as String
Nm = Sheets(2).Cells(3,1)
For i = 1 To Sheets.Count Step 2
arr(0) = Sheets(i).Name
arr(1) = Sheets(i+1).Name
Sheets(arr).Copy
ChDir "C:\aaa"
With ActiveWorkbook
.SaveAs Filename:=Sheets(1).Name & Nm & ".xls", FileFormat:=xlNormal
.Close
End With
Next
End Sub

preseb
02-14-2011, 01:34 PM
I noticed that the vba is not actually looping through. it gets to Next and then I get a debug error of Type mismatch.

I am posting what I have incase I changed something I should have not.

Dim arr(1), i
For i = 5 To Sheets.Count Step 2
arr(0) = Sheets(i).Name
arr(1) = Sheets(i + 1).Name
Sheets(arr).Copy
Application.DisplayAlerts = False

Set i = ActiveSheet
With ActiveWorkbook
.Saveas Filename:=Workbooks("FTE Macro Breakout.xls").Worksheets("Directions").Range("L2").Value & i.Name & " " & Sheets(1).Range("A3").Value & ".xls", FileFormat:=xlNormal
.Close
End With
Application.DisplayAlerts = True
Next

preseb
02-14-2011, 02:55 PM
I got it, unless someone can clean it up?
thanks

Dim arr(1), i
For i = 5 To Sheets.Count Step 2
arr(0) = Sheets(i).Name
arr(1) = Sheets(i + 1).Name
Sheets(arr).Copy
Application.DisplayAlerts = False

With ActiveWorkbook

FTE = Workbooks("FTE Macro Breakout.xls").Worksheets("Directions").Range("I16").Value
Name = Sheets(1).Name & " " & Sheets(1).Range("A3").Value
ActiveWorkbook.Saveas Filename:=FTE & Name & ".xls", FileFormat:=xlNormal
.Close
End With

Next
Application.DisplayAlerts = True
MsgBox "Done!"

mdmackillop
02-14-2011, 03:19 PM
I don't believe Display Alerts is required, as there should be no alerts. Where a value will not change, such as FTE, put the assignment code outside the loop to avoid unneccessary steps.
Also
Always use Option Explicit
Don't use reserved words such as Name as a variable.
Add comments to your code to explain what is going on.

Option Explicit

Sub Test()
Dim arr(1)
Dim i As Long
Dim FTE As String
Dim Nme As String

FTE = Workbooks("FTE Macro Breakout.xls").Worksheets("Directions").Range("I16").Value

For i = 5 To Sheets.Count Step 2
arr(0) = Sheets(i).Name
arr(1) = Sheets(i + 1).Name
Nme = Sheets(i).Name & " " & Sheets(i).Range("A3").Value
Sheets(arr).Copy
With ActiveWorkbook
.SaveAs Filename:=FTE & Nme & ".xls", FileFormat:=xlNormal
.Close
End With
Next
MsgBox "Done!"
End Sub