-1

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?

Saguro
  • 103
  • 7

2 Answers2

0

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
ouroboros1
  • 9,113
  • 3
  • 7
  • 26
  • It seems to work (I still had to work on array, but that was easy to change). I have 1 question: all of my workbooks are `xlsm` so I changed `xlsx from your code to `xlsm` i got an error that i can't save it as `xlsm` "with choosen datatype"- what are the differencies between `xlsx` and `xlsm` and how can I create `xlsm` file then? – Saguro May 17 '22 at 11:44
  • Different Excel file formats are discussed here: https://support.microsoft.com/en-us/office/file-formats-that-are-supported-in-excel-0943ff2c-6014-4e8d-aaea-b83d51d46247. You'll need to add the FileFormat if you want to save the new wb as `xlsm`. I.e. write: `wb_new.SaveAs Filename:=wb.Path & "\wb_new.xlsm", FileFormat:=52`. For all codes, see: https://learn.microsoft.com/en-us/office/vba/api/excel.xlfileformat. In fact, perhaps consider `xlsb` (50): https://stackoverflow.com/questions/7821632/when-should-the-xlsm-or-xlsb-formats-be-use – ouroboros1 May 17 '22 at 13:33
0

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
FaneDuru
  • 38,298
  • 4
  • 19
  • 27