1

I have a file with sheets of monthly reports, and one sheet with all these monthly reports consolidated.
I would like to build a VBA code which will let the user select a range with his mouse (this currently works), and then paste the range selected to the last row +1 in the consolidated sheet (I needed to use column B last row, then move to column A because it is required in my sheet).

Code I built so far:

Sub miseAJour()

    Dim rng As Range
    Dim rgndest As Range
    Set rng = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)
       
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.Offset(0, -1).Select
    
End Sub

The missing part is the paste of rng to the active cell selected.

Community
  • 1
  • 1
Dehoucks
  • 11
  • 1
  • `rng.Copy Destination:=ActiveCell`? Note that you can [avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) though. – BigBen May 10 '21 at 15:36

1 Answers1

1

Application.InputBox with a Range

  • Adjust the values in the constants section.
Option Explicit

Sub miseAJour()
    
    ' Define constants.
    Const dName As String = "Consolidated"
    Const dlrCol As String = "B"
    Const dfCol As String = "A"
    
    ' Define Initial Range Address (the 'Default' parameter).
    Dim dAddress As String
    If TypeName(Selection) = "Range" Then
        dAddress = Selection.Address
    Else ' The current 'Selection' is not a range.
        dAddress = "$A$1"
    End If
    
    ' Attempt to create a reference to the Source (selected) Range.
    Dim srg As Variant
    On Error Resume Next
    Set srg = Application.InputBox( _
        Prompt:="Select a range", Title:="Obtain Range Object", _
        Default:=dAddress, Type:=8)
    On Error GoTo 0
    
    ' Validate Source Range.
    If TypeName(srg) <> "Range" Then
        MsgBox "You canceled.", vbExclamation, "Cancel"
        Exit Sub
    End If
    
    ' Create a reference to the first cell of Destination Range.
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets(dName)
    Dim cOffset As Long
    cOffset = dws.Columns(dfCol).Column - dws.Columns(dlrCol).Column
    Dim dCell As Range
    Set dCell = dws.Range(dlrCol & dws.Rows.Count).End(xlUp).Offset(1, cOffset)
    
    ' Copy values, formats and formulas:
    srg.Copy dCell
    
    ' Or rather copy values only (more efficient (faster)):
    'dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value

End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28