cant paste into a new work book

[Lucyp]

This is my first VBA and it gets stuck at the very end - its not pasting...
I have no clue what to do.
Please if you can look at the code and help me i will appreciate it
Sub Macro3()
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+t
'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A4").Select
ActiveCell.FormulaR1C1 = "Date"
Range("A5").Select
Range("L3").Copy
Range("A5").PasteSpecial , Paste:=xlPasteValues
Rows(3).EntireRow.Delete
Rows(2).EntireRow.Delete
Rows(1).EntireRow.Delete

ActiveCell.EntireColumn.AutoFit

Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("A2").Copy
Selection.PasteSpecial Paste:=xlPasteValues
Columns("I:X").Select
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft

Range("M5").Select

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"C:\Users\lplaczek\Desktop\Summary Report Master File\summaryReport 10.08.21 .xlsm" _
, SubAddress:="summaryReport!A2", TextToDisplay:= _
"C:\Users\lplaczek\Desktop\Summary Report Master File\summaryReport 10.08.21 .xlsm#summaryReport!A2"


LR = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row

Range("A2:K" & LR).Copy

Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True


ActiveSheet.ListObjects("Table1").ListRows.Add AlwaysInsert:=True


Range("A2").Select

Selection.End(xlDown).Offset(1, 0).Select
'ActiveCell.Offset(1, 0).Select


Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False



Sheets("PIVOT").Select

ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
MsgBox (" Wesli Have a nice day")

 

[DanteAmor]

picture one - i download it from a website - i do not save it
i want to run a macro to:
- clean up the data,
- insert the hyperlink
- copy the data
- activate the hyperlink that will take me to my "master workbook" ( picture 2)- this workbook is saved and has 2 tabs one summaryReport ( in here i have Table1) and second PIVOT,
- in summaryReport i want the copied data to be pasted at the bottom of the table.

that all, 2 workbooks-copy from one paste to the other

Try this:

Sub Macro3()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sPath As String
  Dim nRow As Long, lr As Long
  
  Set sh1 = ActiveSheet
  Application.ScreenUpdating = False
  
  sh1.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  sh1.Range("A4").Value = "Date"
  sh1.Range("A5").Value = sh1.Range("L3").Value
  sh1.Rows("1:3").Delete
  
  sh1.Range("A:A").EntireColumn.AutoFit
  
  lr = sh1.Range("B" & Rows.Count).End(xlUp).Row
  sh1.Range("A2").AutoFill sh1.Range("A2:A" & lr)
  sh1.Range("A2").Copy
  sh1.Range("A2:A" & lr).PasteSpecial Paste:=xlPasteValues
  sh1.Range("I:X").Delete Shift:=xlToLeft
  sh1.Range("J:J").Delete Shift:=xlToLeft
  sh1.Range("G:G").Delete Shift:=xlToLeft
  sh1.Range("E:E").Delete Shift:=xlToLeft
  
  sPath = "C:\Users\lplaczek\Desktop\Summary Report Master File\summaryReport 10.08.21 .xlsm"
  sPath = "C:\Users\damor\Documents\Docs\Soporte Mr Excel\user files\summaryReport 10.08.21.xlsm"
  sh1.Hyperlinks.Add Anchor:=sh1.Range("M5"), _
    Address:=sPath, SubAddress:="summaryReport!A2", _
    TextToDisplay:=sPath & "#summaryReport!A2"
  
  sh1.Range("M5").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  
  Set sh2 = Sheets("summaryReport")
  sh2.ListObjects("Table1").ListRows.Add AlwaysInsert:=True
  nRow = sh2.ListObjects("Table1").DataBodyRange.Rows.Count
  
  lr = sh1.Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
  sh1.Range("A2:K" & lr).Copy
  
  sh2.ListObjects("Table1").DataBodyRange(nRow, 1).PasteSpecial xlValues
  Application.CutCopyMode = False
  
  Sheets("PIVOT").PivotTables("PivotTable1").PivotCache.Refresh
  MsgBox (" Wesli Have a nice day")
End Sub

 

[Lucyp]

YES YES YES!!!!!! THANK YOU SO MUCH?

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.