Copy values from range to cell. Without using clipboard of course.
Here the FromRange can have more than one cell in width or height, while To1stCell should be 1 cell address.
Why? because the function will dynamically expand To1Cell to fit same width and height of FromRange.
Just like Copy and paste, but without using clipboard.
Edit 2023-12-06: Adding flag PasteAsText to force function to paste values with leading zeros without issue.
Sub CopyDynamicRangeValue(FromRange, To1stCell, Optional FromSheet = "Active", Optional ToSheet = "Active", Optional FromWB = "This", Optional ToWB = "This", Optional PasteAsText = 0)
' Copies a range from location to another dynamically
' Means will adjust destination range to have same number of rows and columns as FromRange starting from To1stCell
' Does not use clipboard to copy-paste
If FromWB = "This" Then FromWB = ThisWorkbook.Name
If FromWB = "Active" Then FromWB = ActiveWorkbook.Name
If FromSheet = "Active" Then FromSheet = ActiveSheet.Name
If ToWB = "This" Then ToWB = ThisWorkbook.Name
If ToWB = "Active" Then ToWB = ActiveWorkbook.Name
If ToSheet = "Active" Then ToSheet = ActiveSheet.Name
FromRs = Range(FromRange).Rows.Count
FromCs = Range(FromRange).Columns.Count
ToRange = To1stCell & ":" & Range(To1stCell).Offset(FromRs - 1, FromCs - 1).Address(0, 0)
If PasteAsText = 1 Then Workbooks(ToWB).Worksheets(ToSheet).Range(ToRange).NumberFormat = "@"
Workbooks(ToWB).Worksheets(ToSheet).Range(ToRange).Value = Workbooks(FromWB).Worksheets(FromSheet).Range(FromRange).Value
End Sub
' Copies a range from location to another dynamically
' Means will adjust destination range to have same number of rows and columns as FromRange starting from To1stCell
' Does not use clipboard to copy-paste
If FromWB = "This" Then FromWB = ThisWorkbook.Name
If FromWB = "Active" Then FromWB = ActiveWorkbook.Name
If FromSheet = "Active" Then FromSheet = ActiveSheet.Name
If ToWB = "This" Then ToWB = ThisWorkbook.Name
If ToWB = "Active" Then ToWB = ActiveWorkbook.Name
If ToSheet = "Active" Then ToSheet = ActiveSheet.Name
FromRs = Range(FromRange).Rows.Count
FromCs = Range(FromRange).Columns.Count
ToRange = To1stCell & ":" & Range(To1stCell).Offset(FromRs - 1, FromCs - 1).Address(0, 0)
If PasteAsText = 1 Then Workbooks(ToWB).Worksheets(ToSheet).Range(ToRange).NumberFormat = "@"
Workbooks(ToWB).Worksheets(ToSheet).Range(ToRange).Value = Workbooks(FromWB).Worksheets(FromSheet).Range(FromRange).Value
End Sub
FromRange, To1stCell, Optional FromSheet = "Active", Optional ToSheet = "Active", Optional FromWB = "This", Optional ToWB = "This", Optional PasteAsText = 0
Views 168
Downloads 57
CodeID
DB ID