Daily Run data (copy data in loop by daily in worksheet)

[chingg1011]

Hi VBA Expert,

I am meeting a difficult to perform "Daily Run data"

The background is that I want to copy daily data onto my separate worksheet, but need to keep old data (accumulated data 1 Jan 24, 2 Jan 24, 3 Jan 24....etc) I have recorded a marco as below:
My problem is when I try to click "Ctrl + Arrow down" A41 and drop one more row A42 for 3 Jan, 4 Jan..etc. The data to reach is always at Row A42, It is failure to copy new data after 2 Jan ......etc

Can any expert edit my code to make it successful ?

Thanks
Dennis






Below is my marco and screen shot for easy ref

========================================================================================================================================


Sub Daily_Run()
'
' Daily_Run Macro
'

'
Application.CutCopyMode = False
Selection.Copy
Workbooks.Open Filename:= _
"https://hkwbl.sharepoint.com/teams/...20240331/Data/LOAN_Table_2024-01-25T1001.xlsx"
Range("A1:AX12909").Select
Range("A2").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Selection.End(xlUp).Select
Range("Z1").Select
ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("Z1:Z12909"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
Selection.End(xlToLeft).Select
Range("A2:AX21").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Loan table top 20").Select
Range("A2").Select
Selection.End(xlDown).Select
Range("A42").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
ActiveWindow.Close
Sheets("macro").Select
ActiveWorkbook.Save
End Sub
==========================================================================================================================================

 

[dermie_72]

Youre telling it to paste at that spot

Range("A42").Select
ActiveSheet.Paste

If you remove the Range("A42").Select and change it to Activecell.offset(1,0).Select that should put you in the Next empty row.

 

[chingg1011]

Youre telling it to paste at that spot

Range("A42").Select
ActiveSheet.Paste

If you remove the Range("A42").Select and change it to Activecell.offset(1,0).Select that should put you in the Next empty row.

Hi Dermie,

I found below error when Row A2 is empty, and also cannot function the vba (If there is a new data of month ie Feb 24 starting at Row A2), it doesn't work. can you help ?

Sub Daily_Run()
'
' Daily_Run Macro
'



'
Dim workbookname As String
workbookname = InputBox("Enter file name:", , "Loan daily table Q1 2024_dmV2.xlsm")
If workbookname <> "" Then
Range("Q6") = workbookname
Application.ScreenUpdating = False

Dim filname1 As String
filename1 = Range("Q5").Text

Application.CutCopyMode = False
Range("B8").Select
Selection.Copy
Workbooks.Open Filename:=Range("B8").Text
Range("A1:AX12909").Select
Range("A2").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Selection.End(xlUp).Select
Range("Z1").Select
ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("Z1:Z12909"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
Selection.End(xlToLeft).Select
Range("A2:AX21").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Loan table top 20").Select
ActiveCell.Offset(1, 0).Select 'copy data to next empty row'
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select 'copy data to next empty row'
ActiveSheet.Paste
Workbooks(filename1).Activate
ActiveWindow.Close
Sheets("macro").Select
ActiveWorkbook.Save
End If
MsgBox "Workdone"
End Sub

 

[dermie_72]

Correct me if im wrong:
You asked to have the data from one sheet get copied into a cumulative sheet showing all the historical data?
If that's the case. You code could be alot more simple. There are sorting going on before the paste. Do you want the old data at the bottom and new data at the top?
Of all the new data at the bottom of the file?
Also assuming that you're pasting the data into column A.

Sub chingg1011()
Dim LR, RC As Long

Application.CutCopyMode = False
Selection.Copy                  'This copies the data from the original file
RC = Selection.Rows.Count       'This identifies how many rows you're copying. (In case you want it at the top
Workbooks.Open Filename:= _
"https://hkwbl.sharepoint.com/teams/...20240331/Data/LOAN_Table_2024-01-25T1001.xlsx"
                                'This opens the file you want to put the data into
Sheets("Sheet 1").Select        'This makes sure the sheet you're pasting the data in is correct.  Rename the sheet if your sheet name is also different

LR = Cells(Rows.Count, "A").End(xlUp).Row + 1 'This gives you the first blank row
Range("A" & LR).Select
ActiveSheet.Paste

ActiveWindow.Close
Sheets("macro").Select
ActiveWorkbook.Save
End Sub

Try this code and use the F8 step through button from selecting the data you want to copy. See if this does what you need. If not, please expand on your needs