1

I'm currently writing a macro where I'm just copy/pasting all of the data in a daily sheet to a monthly sheet. However, the data is always uploaded to the same cells.

My question is how can I make it so that everytime I activate the macro, it uploads at the end of the previous days instead of a fixed position? Any help is appreciated, thank you.

Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("sheet.xlsx").Activate
Range("A2").Select
Selection.End(xlDown).Select

Range("A1224").Select

BigBen
  • 46,229
  • 7
  • 24
  • 40
  • 1
    You might consider reading [how to find the last used cell](https://stackoverflow.com/questions/11169445/find-last-used-cell-in-excel-vba). Also [paste on next empty row](https://stackoverflow.com/questions/52662029/vba-paste-on-next-empty-row). – BigBen Aug 24 '23 at 19:19
  • Side note: You will also want to [avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code – cybernetic.nomad Aug 24 '23 at 19:20

2 Answers2

1

Append Table Data Using CurrentRegion

Before

enter image description here

After

enter image description here

The Code

Sub AppendTableData()
    Const PROC_TITLE As String = "Append Table Data"
    
    ' Define constants.
    
    Const SRC_FIRST_DATA_CELL As String = "A2"
    Const DST_SHEET As String = "Monthly"
    Const DST_FIRST_DATA_CELL As String = "A2"
    
    ' Use an array of names of the sheets that you don't want to be written to.
    Dim Exclusions(): Exclusions = Array("Monthly", "Dummy") ' add more

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    
    Dim sws As Worksheet: Set sws = wb.ActiveSheet
    Dim sName As String: sName = sws.Name
    
    If IsNumeric(Application.Match(sName, Exclusions, 0)) Then
        MsgBox "The sheet """ & sName & """ is selected." & vbLf _
            & "Please select one of the daily sheets.", vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    Dim sCell As Range: Set sCell = sws.Range(SRC_FIRST_DATA_CELL)
    
    Dim srg As Range
    
    With sCell.CurrentRegion
        Set srg = sCell.Resize(.Row + .Rows.Count - sCell.Row, _
            .Column + .Columns.Count - sCell.Column)
    End With
    
    ' Destination
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
    Dim dCell As Range: Set dCell = dws.Range(DST_FIRST_DATA_CELL)
    
    Dim drrg As Range, IsDataRangeEmpty As Boolean
    
    With dCell.CurrentRegion
        Set drrg = dCell.Resize(.Row + .Rows.Count - dCell.Row, _
            .Column + .Columns.Count - dCell.Column)
        If drrg.Rows.Count = 1 Then ' the destination data range has one row
            If Application.CountA(drrg) = 0 Then ' the dest. data range is empty
                IsDataRangeEmpty = True
            End If
        End If
        If Not IsDataRangeEmpty Then
            Set dCell = drrg.Cells(1).Offset(drrg.Rows.Count)
        End If
    End With
    
    ' Copy.
    
    srg.Copy dCell

    ' Inform.
    
    MsgBox "The daily data from sheet """ & sName & """ has been copied " _
        & "to sheet """ & DST_SHEET & """!", vbInformation, PROC_TITLE
    
'    Debug.Print String(43, "-")
'    Debug.Print "Sheet", "Name", "Range Reference"
'    Debug.Print String(43, "-")
'    Debug.Print "Source", sws.Name, srg.Address
'    Debug.Print "Destination", dws.Name, dCell.Address
    
End Sub

MsgBox

enter image description here

Result in the Immediate Window (Ctrl+G)

-------------------------------------------
Sheet         Name          Range Reference
-------------------------------------------
Source        2023-08-25    $A$2:$C$3
Destination   Monthly       $A$2
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
0

You mention that you have two "sheets", which I assume are in the same workbook. To ensure you are copying data from/to the correct sheets, I suggest you specify the worksheet with the Range function. To append the data to a new row, use Range.End(xlDown).Offset(1). I also think it'd be best to resize the destination range to have the same number of rows and columns as the source range. Finally, the Range.Copy method can take a Destination parameter so that copying and pasting all happens in one operation.

Dim dailySheet As Worksheet, monthlySheet As Worksheet
Dim startCell as Range, source as Range, destination as Range
Dim nextRow As Range

Set dailySheet = Worksheets("daily_sheet_name")
Set monthlySheet = Worksheet("monthly_sheet_name")

Set startCell = dailySheet.Range("A2")
Set source = Range(startCell, startCell.End(xlDown).End(xlToRight))

Set nextRow = monthlySheet.Range("A2").End(xlDown).Offset(RowOffset:=1)
Set destination = nextRow.Resize(RowSize:=source.Rows.Count, ColumnSize:=source.Columns.Count)

source.Copy Destination:=destination
ogdenkev
  • 2,264
  • 1
  • 10
  • 19