VBA to Paste Values and Number Formatting

[MrDB4Excel]

I have tried in vain to create an Xlam file or just a simple VBA that allows me to create a selection set and then paste that content to another location via another selection cell or range.
By selection set, I refer to the code giving time to select a range.
I have tried several approaches but something is not working right.
So if anyone can steer me in the right direction with code that does the following it would be much appreciated.
Item number 1 is a question regarding correct syntax.
I now do this using items 2 through 5 below, and I would like to use number 6 instead of selecting the Quick Access Toolbar button.
Items 2 through 5 are often repeated for other named ranges throughout this workbook.

1) Here on the first line do I need to have a macro name?
2) First I pick a cell that highlights a specific range, this cell is hyperlinked to a named range
3) Next I do the CTRL-C
4) Next I select a cell that jumps to another sheet ((((this is the content of that cell: =HYPERLINK("#DailyInitialData!a"&(COUNTA(AW:AW)+J2),"2: Paste in DailyInitialData")
5) Next I select the Quick Access Toolbar button for Pasting Values And Number Formats
6) Instead of selecting the Quick Access Toolbar button for Pasting Values And NumberFormats I want to create a button on the sheet field that does this using the following code which obviously is missing vital script:



rRange.pastespecial xlPasteValuesAndNumberFormats = True

End If

End Sub

 

[jkpieterse]

Here is a stab at it:

Sub CopyPasteValuesNumFormats()
    Dim pasteRng As Range
    Dim copyRng As Range
    'Select what to copy
    On Error Resume Next
    Set copyRng = Application.InputBox("Please select the range to copy", "Range to copy", "namedRange2CopyGoesHere", , , , , 8)
    On Error GoTo 0

    If Not copyRng Is Nothing Then
        'if we haven't cancelled selecting what to copy
        With Worksheets("DailyInitialData")
            'take the last row in column AW containing anything and paste beneath that row,
            'offset by whatever is in cell J2
            Set pasteRng = .Range("A" & .Range("AW" & .Rows.Count).End(xlUp).Row + 1 + .Range("J2").Value)
        End With
        'Now do the copy and paste special
        copyRng.Copy
        pasteRng.PasteSpecial xlPasteValuesAndNumberFormats
        'Empty clipboard
        Application.CutCopyMode = False
    End If
End Sub

 

[MrDB4Excel]

Here is a stab at it:

Sub CopyPasteValuesNumFormats()
    Dim pasteRng As Range
    Dim copyRng As Range
    'Select what to copy
    On Error Resume Next
    Set copyRng = Application.InputBox("Please select the range to copy", "Range to copy", "namedRange2CopyGoesHere", , , , , 8)
    On Error GoTo 0

    If Not copyRng Is Nothing Then
        'if we haven't cancelled selecting what to copy
        With Worksheets("DailyInitialData")
            'take the last row in column AW containing anything and paste beneath that row,
            'offset by whatever is in cell J2
            Set pasteRng = .Range("A" & .Range("AW" & .Rows.Count).End(xlUp).Row + 1 + .Range("J2").Value)
        End With
        'Now do the copy and paste special
        copyRng.Copy
        pasteRng.PasteSpecial xlPasteValuesAndNumberFormats
        'Empty clipboard
        Application.CutCopyMode = False
    End If
End Sub

After the line: Set copyRng = Application.InputBox("Please select the range to copy", "Range to copy", "Day_Init_Data", , , , , 8) then the macro stops and does nothing.
It does select this range and institutes the copy but then nothing after this.
I will attach a couple Xl2bb mini sheets to help you to see what is going on.

VBA-Testing.xlsm
	B	C	D	E	F	G	H	I	J	K	L
2	Today's Date	Time	TMC CZK to USD	TMC USD to CZK	TMC USD to EUR	TMC EUR to USD			TMC = The Money Converter	VBA-Testing.xlsm
3	Tue--25 Feb 2025	13:34:43	0.0419338	23.8471000	0.9546900	1.0474604		2: Paste in DailyInitialData		3	1: Get A2-F2
4
5										Date	2025
6								25/02/2025	13:34:43	Tue-25 Feb 2025
7								EUR to USD >>>	1.0474604	K7
8								USD to EUR >>>	0.9546900	25/02/2025
9								USD to CZK >>>	23.8471000	13:34:43
10								CZK to USD >>>	0.0419338
Current Rates

Cell Formulas
Range	Formula
K2	K2	=IF(ISERROR(MID(CELL("filename",$B$2),FIND("[",CELL("filename",$B$2))+1,FIND("]",CELL("filename",$B$2))-FIND("[",CELL("filename",$B$2))-1)),"This workbook never saved",MID(CELL("filename",$B$2),FIND("[",CELL("filename",$B$2))+1,FIND("]",CELL("filename",$B$2))-FIND("[",CELL("filename",$B$2))-1))
B3,K8,K6	B3	=TODAY()
C3,K9	C3	=NOW()
D3	D3	=$J$10
E3	E3	=$J$9
F3	F3	=$J$8
G3	G3	=$J$7
I3	I3	=HYPERLINK("#DailyInitialData!a"&(COUNTA(AG:AG)+K3),"2: Paste in DailyInitialData")
K3	K3	=DailyInitialData!K1
I6	I6	=K8
J6	J6	=K9
J7	J7	='F:\Finances\CSOB\2025\[All-In-One.xlsm]USD-Primary'!I3
J8	J8	='F:\Finances\CSOB\2025\[All-In-One.xlsm]USD-Primary'!I2
J9:J10	J9	='F:\Finances\CSOB\2025\[All-In-One.xlsm]USD-Primary'!J2

VBA-Testing.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Date	Time	TMC CZK to USD	TMC USD to CZK	TMC USD to EUR	TMC EUR to USD	CZK From Pension $ Per TMC	Dollars		1	3	3	K7	$B$3	1
2	Tue--25 Feb 2025	13:34:24	0.0419338	23.8471000	0.9546900	1.0474604	2,384.71 ₽	$100.00
DailyInitialData

Cell Formulas
Range	Formula
J1	J1	=EXTRACTNUMBERS(O1,TRUE)
K1	K1	=SUM(J1+2)
L1	L1	=EXTRACTNUMBERS(K1)
N1	N1	=ADDRESS(L1,2)
O1	O1	=COUNTA(C2:C22)
G2	G2	=IF(D2*$H2=0,"",D2*$H2)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A2:G5	Expression	=WEEKDAY($A2)=1	text	NO

Hope this helps.

 

[jkpieterse]

Try if this works better:

Sub CopyPasteValuesNumFormats()
    Dim pasteRng As Range
    Dim copyRng As Range
    'Select what to copy
    On Error Resume Next
    Set copyRng = Application.InputBox("Please select the range to copy", "Range to copy", Range("namedRange2CopyGoesHere").Address, , , , , 8)
    On Error GoTo 0

    If Not copyRng Is Nothing Then
        'if we haven't cancelled selecting what to copy
        With Worksheets("DailyInitialData")
            'take the last row in column AW containing anything and paste beneath that row,
            'offset by whatever is in cell J2
            Set pasteRng = .Range("A" & .Range("AW" & .Rows.Count).End(xlUp).Row + 1 + .Range("J2").Value)
        End With
        'Now do the copy and paste special
        copyRng.Copy
        pasteRng.PasteSpecial xlPasteValuesAndNumberFormats
        'Empty clipboard
        Application.CutCopyMode = False
    End If
End Sub

 

[MrDB4Excel]

Try if this works better:

Sub CopyPasteValuesNumFormats()
    Dim pasteRng As Range
    Dim copyRng As Range
    'Select what to copy
    On Error Resume Next
    Set copyRng = Application.InputBox("Please select the range to copy", "Range to copy", Range("namedRange2CopyGoesHere").Address, , , , , 8)
    On Error GoTo 0

    If Not copyRng Is Nothing Then
        'if we haven't cancelled selecting what to copy
        With Worksheets("DailyInitialData")
            'take the last row in column AW containing anything and paste beneath that row,
            'offset by whatever is in cell J2
            Set pasteRng = .Range("A" & .Range("AW" & .Rows.Count).End(xlUp).Row + 1 + .Range("J2").Value)
        End With
        'Now do the copy and paste special
        copyRng.Copy
        pasteRng.PasteSpecial xlPasteValuesAndNumberFormats
        'Empty clipboard
        Application.CutCopyMode = False
    End If
End Sub

Maybe I am not doing something right because this still just stops after doing the copy.

 

[jkpieterse]

Have you edited the code so "namedRange2CopyGoesHere" matches the named range you want to have copied?
Comment that "On error resume next" and then run the code, if there is an error it should show it.

 

[MrDB4Excel]

Have you edited the code so "namedRange2CopyGoesHere" matches the named range you want to have copied?
Comment that "On error resume next" and then run the code, if there is an error it should show it.

Yes, I do change that to indicate the exact named range. What is puzzling is this:
Set pasteRng = .Range("A" & .Range("AW" & .Rows.Count).End(xlUp).Row + 1 + .Range("k3").Value)
Again, when I get the named range into a copy mode it just all stops and nothing else happens.
The paste range is determined by picking the cell I3 which has the formula:
=HYPERLINK("#DailyInitialData!a"&(COUNTA(AG:AG)+K3),"2: Paste in DailyInitialData")
Did you check out all in the mini sheets?