VBA - copy a dynamic range to a new workbook

0
votes

I'm trying to figure out how to copy a dynamic range into a new workbook. The actual project is to generate monthly budget reports based on the user's choice of month. The overarching system tracks a number of budget lines, where each line has its own sheet, and each sheet holds 12 tables for the fiscal year for expenses to be input; it all feeds back into an annual budget sheet. Upon the user picking a month, a new workbook will be created, mirroring the number of sheets and filling each sheet with that month's table. Each table is a dynamic range.

What I've got below is a dry run to work out the mechanics, but the problem is that I cannot get the dynamic range to paste correctly:

Sub pasting()

On Error Resume Next

Dim x As Workbook
Dim y As Workbook

'set the budget tracking system as the active workbook
Set x = Workbooks("Save and copying proof of concept.xlsm")

'activate budget tracking system
x.Activate

Set y = Workbooks.Add

Dim z As Range
Dim w As Range


'test copying two cells in two sheets into new sheets in the new workbook
Set z = Workbooks("Save and copying proof of concept.xlsm").Sheets("Sheet1").Range("A1")
Set w = Workbooks("Save and copying proof of concept.xlsm").Sheets("Sheet2").Range("A1")

'call saveas option for monthly workbook
With y
    Call save_workbook_newName
End With

'add 8 sheets to new workbook for 8 budget lines
Dim v As Worksheet
Dim i As Integer

For i = 1 To 7
   Sheets.Add

Next i

'copy the specified range from the original sheet and into the newly created workbook.

z.Copy
y.Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues

w.Copy
y.Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues

'copy a dynamic range to a new workbook

x.Worksheets("Sheet3").Activate

Dim xRow As Long, xColumn As Long

'determine the row and column limits of the dynamic range
Range("A100").End(xlUp).Select
xRow = ActiveCell.Row

Range("D").End(xlToLeft).Activate
xColumn = ActiveCell.Column

'select the range specified by the dynamic boundaries
Range(Cells(1, 1), Cells(xRow, xColumn)).Select

Selection.Copy

'activate newly created workbook
y.Worksheets("Sheet3").Activate

'paste into the new workbook
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, SkipBlanks:=False, _
    Transpose:=False

End Sub



Sub save_workbook_newName()

    Dim workbook_name As Variant

    'display the SaveAs dialog box
    'once a name is provided, the GetSaveAsFilename method gets the particular name and _
    'assigns that name to the workbook_name variable

    workbook_name = Application.GetSaveAsFilename

    'if the user provides a filename, the true condition is executed, and if not (presses Cancel), the false condition is executed.
    If workbook_name <> False Then

    'the application.acriveworkbook property returns the workbooks to the current active window
    'saves the file with the file name given by the user.

        ActiveWorkbook.SaveAs Filename:=workbook_name & "xlsx"
    Else
        ActiveWorkbook.Close
    End If

End Sub

This bit is the problematic code:

Range("A100").End(xlUp).Select
xRow = ActiveCell.Row

Range("D").End(xlToLeft).Activate
xColumn = ActiveCell.Column

'select the range specified by the dynamic boundaries
Range(Cells(1, 1), Cells(xRow, xColumn)).Select

It essentially only copies column A, even if it's told to activate column D and choose everything to the left of it (Columns A to C hold random numbers).

Using this method for selecting a dynamic range did not yield good results:

LR = Range("D1000").End(xlUp).Row
Set R1 = Range("D1:E" & LR)

Thanks, and I appreciate your help in this respect!

2
vbaexcel

2 Answers

0
votes

Another approach using .Resize. I think this method is a bit better than @Thomas Inzina because it goes along column and row headers (the .End methods) which are likely to not have empty cells. In Thomas'es example, if your data has empty cells in the last column, the code will copy incomplete table.

Source Table

Sub copyTableIntoNewWorksheet()

    ' locate the dynamic range / table
    Dim rngTable As Range
    With ActiveSheet.[b2]    ' top left cell of the dynamic range
        Set rngTable = .Resize(Range(.Offset(0), .End(xlDown)).Rows.Count, _
                               Range(.Offset(0), .End(xlToRight)).Columns.Count)
    End With

    ' create new worksheet
    Dim wsNew As Worksheet
    Set wsNew = Worksheets.Add
    wsNew.Name = "New Sheet"

    ' copy table to new worksheet
    rngTable.Copy wsNew.[a1] ' top left cell where to copy the table to

End Sub
0
votes

The Range object can take two parameters Range([Cell1],[Cell2). Gereerally, you'll use the top left cell as first parameter and the bottom right cell as the second.

The first parameter of your code is Cells(1, 1) and the second is Cells(xRow, xColumn). The range will extend from Row 1 Column 1 to Row xRow, Column xColumn.

Range(Cells(1, 1), Cells(xRow, xColumn))

There is no need to select a range when copying and pasting. We can chain ranges methods together.

Here we set a range that starting in D100 extending to the leftmost column and then down to the last used cell in the list. We then copy it and paste it into y.Worksheets("Sheet3").Range("A1").

Foe example:

Dim rw As Long, Cell1 As Range, Cell2 As Range
Dim y As Workbook
Set x = Workbooks.Add
Set y = Workbooks("Book5.xlms")
rw = 100
Set Cell1 = Range("A" & rw)
Set Cell2 = Range("A" & rw).End(xlToRight).End(xlDown)    'This is the bottom left cell in the table
Set Target = Range(Cell1, Cell2)
Target.Copy x.Worksheets("Sheet1").Range("A1")

We can do all this on 1 line like this:

rw = 100
Range("D" & rw, Range("D" & rw).End(xlToRight).End(xlDown)).Copy y.Worksheets("Sheet3").Range("A1")