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]

Hi and welcome to MrExcel.

You must first insert the row into the table.
After copy and paste, try the following:

Sub Macro3_1()
  '
  ' 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"
 
  Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  ActiveSheet.ListObjects("Table1").ListRows.Add AlwaysInsert:=True
 
  LR = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
  Range("A2:K" & LR).Copy
  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")
End Sub

 

[Lucyp]

Hi

DanteAmor,​

Thank you for your response!

it doesn't work... what it does as far as I see- instead of pasting copied data from original workbook this code just selects the data in master file and copy it in the last row...

what i mean to do is to copy data from a report then hyperlink it to master file and paste it there in the last row co its ready so the pivot...
if that makes sense...

 

[DanteAmor]

Could you explain in more detail what you want to copy (book, sheet, range)
And where do you want to paste it (book, sheet, range)

It would be great if you also explain it with a couple of pictures.

 

[Lucyp]

I will try....
every week we download a report ( attachment 1)
i need to alter it to data requested ( delete some columns-always the same)
then i need to copy all that data into a workbook( picture 2)- to do that i created a hyperlink.

for Pivot the data has to in the table... so i need to add a row in the table and then paste- thats where i get stuck...

?‍

 

[DanteAmor]

Could you explain in more detail what you want to copy (book, sheet, range)
And where do you want to paste it (book, sheet, range)

Sorry, I'm not understanding.
Do you have two open books?
Or is it just a book?
Do you want to copy from the sheet "SummaryReport" and paste in the sheet "Pivot", in the sheet "Pivot" do you have a table called "Table1"?

By the way, the images do not show the names of the sheets, nor the name of the book, it does not have information either, the sheets are empty.
The idea of the images is to be able to see the data, that the data from sheet A can be seen and also appreciate that those data from sheet A are now on sheet B. But with the empty sheets, I can only imagine what you need.

If you have confidential information you can replace it with generic data.

 

[DanteAmor]

I think I already understood.
Try the following:

Sub Macro3()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sPath As String
  Dim nRow As Long, lr As Long
 
  Application.ScreenUpdating = False
  Set sh1 = ActiveSheet
 
  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"
 
  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("PIVOT")
  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
 
  sh2.PivotTables("PivotTable1").PivotCache.Refresh
  MsgBox (" Wesli Have a nice day")
End Sub

 

[Lucyp]

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

 

[Lucyp]

I think I already understood.
Try the following:

Sub Macro3()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sPath As String
  Dim nRow As Long, lr As Long
 
  Application.ScreenUpdating = False
  Set sh1 = ActiveSheet
 
  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"
 
  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("PIVOT")
  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
 
  sh2.PivotTables("PivotTable1").PivotCache.Refresh
  MsgBox (" Wesli Have a nice day")
End Sub

I think I already understood.
Try the following:

Sub Macro3()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sPath As String
  Dim nRow As Long, lr As Long
 
  Application.ScreenUpdating = False
  Set sh1 = ActiveSheet
 
  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"
 
  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("PIVOT")
  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
 
  sh2.PivotTables("PivotTable1").PivotCache.Refresh
  MsgBox (" Wesli Have a nice day")
End Sub

 

[Lucyp]

its stuck