Creating new worksheet from array-CodePudding

I have got a worksheet with some data. I store that data in an array and then I want to create a new worksheet and save the data into a new worksheet.

Right now I'm creating a new sheet in the workbook of origin data like this:

Sub New_workbook()
   Dim sh as Worksheet, origin as Worksheet, arr
   origin = Sheets("OriginSheet")
   sh = ActiveSheet

   somedata = origin.Range("A1:C").Value

   ReDim arr(1 To 100, 1 To 3)
   
   For i = 1 To 100
      arr(i, 1) = somedata(i, 1)
      arr(i, 2) = somedata(i, 2)
      arr(i, 3) = somedata(i, 3)
   Next i

   sh.Range("A2").Resize(UBound(arr), UBound(arr, 2)).Value = arr

End Sub

and instead of sh = ActiveSheet, I would like to have something like sh = NewWorkbook("Name_of_new_workbook") and create a workbook in the directory of OriginSheet workbook or given path and fill it with arr values. How can I do this in VBA?

CodePudding user response：

If you are looking to copy all the data in your source range, it isn't necessary to store that data in an array first. Just Set your range and make the value of the destination range equal the value of the source range. Try something like this:

Sub CopyRangeIntoNewWorkbook()

'disabling screen update and calculation to speed things up
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim wb As Workbook, wb_new As Workbook
Dim ws As Worksheet
Dim rng As Range

Set wb = ActiveWorkbook
Set ws = ActiveSheet

'set the rng for which you want to copy the values
Set rng = ws.Range("A1:C10")

'set wb_new to newly added wb
Set wb_new = Workbooks.Add()

'specify the top left cell of the range you want to have populated in the new wb
wb_new.Sheets(1).Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Value2 = rng.Value2

'save file, here using path of your original wb'
wb_new.SaveAs Filename:=wb.path & "\wb_new.xlsx"
'closing the new file
wb_new.Close saveChanges:=False

'enabling screen update and automatic calculation again
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

CodePudding user response：

The most eficient way to copy a sheet content in a new workbook should be the next one:

Sub New_workbook()
   Dim origin As Worksheet
   Set origin = Sheets("OriginSheet") 'an object must be Set
   origin.Copy 'this will create a new workbook with the content of the copied sheet
   ActiveWorkbook.saveas origin.Parent.path & "\" & "Name_of_new_workbook" & ".xlsx", xlWorkbookDefault
End Sub

If needing to keep only columns "A:C", you can add the next code lines:

   Dim sh As Worksheet, lastCol As Long
   Set sh = ActiveWorkbook.Worksheets(1)
   lastCol = sh.cells.SpecialCells(xlCellTypeLastCell).Column
   If lastCol <= 3 Then Exit Sub
   If lastCol = 4 Then sh.cells(1, 4).EntireColumn.Delete: Exit Sub
   sh.Range(sh.cells(1, 4), sh.cells(1, lastCol)).EntireColumn.Delete