Macro help - add data from a tab to the bottom of the existing data

[jimbogarner]

Hi,

Ive created a macro in a workbook that takes data from a tab 'Latest data' and adds it to another tab, however, the following month when that data gets replaced with the following months 'latest data', I want that macro to add the new data to the bottom of what was added before - it currently just overwrites what was there previously?

This is the macro that I recorded;

Sub Run_Rec()
'
' Run_Rec Macro
'

'
Sheets("Latest Data").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Rows("1:59").Select
Selection.Copy
Sheets("B&G SAP DL").Select
ActiveWindow.SmallScroll Down:=15
Range("A70").Select
ActiveSheet.Paste
Range("F69").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("F69:F128")
Range("F69:F128").Select
ActiveWindow.SmallScroll Down:=12
Range("J70").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("Q70").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("Q70"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
ActiveWindow.SmallScroll Down:=-12
Range("R70").Select
Sheets("B&G").Select
Range("B23").Select
ActiveSheet.PivotTables("PivotTable3").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"\\ni.ad.newsint\SharedData\Central\PetGroup\petcommon\PETERB\Wireless Group\9. Month End\FY22\6. December\B&G\BS Recs\[Accruals - B&G - Dec 21.xlsx]B&G SAP DL!R1C1:R128C19" _
, Version:=xlPivotTableVersion15)
Range("C19").Select
Calculate
Sheets("B&G SAP DL").Select
Range("F105").Select
Sheets("B&G").Select
Range("C22").Select
ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh
End Sub

Thanks,

James

 

[jimbogarner]

I think as a follow up question as well, looking at my macro - it is doing the 'delimeter' part and also updating the pivot table based on the range I selected when recording, however, when the problem above is fixed, it isn't going to then update for the new range of data?

 

[jimbogarner]

Hi, anyone about that can help? TIA

 

[Alex Blakenburg]

The below is not quite there but is getting there.
I need to know if Column Q is in the "Latest Data" sheet or whether it is an addtional column added on.
I also need some sample data for column Q before the Text to columns runs. I think the code is splitting it into 3 columns.

Does the "Latest Data" sheet have a header row that I the code should be excluding from the copy ?

I have commented out the TextToColumns line because without sample data I can't get it to work.

Sub AppendLatest()
'
'
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Dim srcLastRow As Long, destLastRow As Long, destNextRow As Long
    Dim rngData As Range

    With Worksheets("Latest Data")
        .Range("A1").CurrentRegion.Copy
    End With
        
    With Worksheets("B&G SAP DL")
        destLastRow = .Cells(1, "A").End(xlDown).Row
        destNextRow = destLastRow + 1
        
        .Range("A" & destNextRow).PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False
        destLastRow = .Cells(1, "A").End(xlDown).Row
        
        .Range(.Cells(destNextRow - 1, "F"), .Cells(destLastRow, "F")).FillDown
        Application.Calculate
        
        .Range(.Cells(destNextRow, "Q"), .Cells(destLastRow, "Q")).Value = _
                .Range(.Cells(destNextRow, "J"), .Cells(destLastRow, "J")).Value
                
'        .Range(.Cells(destNextRow, "Q"), .Cells(destLastRow, "Q")).TextToColumns _
'                Destination:=Range("Q" & destLastRow), DataType:=xlDelimited, _
'                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
'                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
'                :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
'                TrailingMinusNumbers:=True
                
        Set rngData = .Range("A1").CurrentRegion
    End With
    
    With Worksheets("B&G")
        .PivotTables("PivotTable3").ChangePivotCache ActiveWorkbook. _
            PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData _
            , Version:=xlPivotTableVersion15)
        .PivotTables("PivotTable3").PivotCache.Refresh
    End With
    
    Worksheets("B&G SAP DL").Activate
        Range("A1").Select
    Worksheets("B&G").Activate
        Range("A1").Select

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

 

[jimbogarner]

Hi Alex,

Really sorry for the delayed response, after asking for the information we then had a load of urgent priorities come up at work so this ended up being put to the back, I've picked this back up again now though!

In terms of the data, screenshots below but I want to post something like this, (first image) to the bottom of the data in the second image, the below is a small selection and it could be thousands of lines so I need it to be dynamic but for the purpose of the below I've taken a small sample;

Thanks,

James

 

[jimbogarner]

Just nudging this back up please!

 

[Alex Blakenburg]

Your post #5 is a much abbreviated version of the requirement indicated by initial Macro.

If that is all you want then this should do it.

Sub AppendLatest()

    Dim rgSource As Range, rgDest As Range
    Dim shSource As Worksheet, shDest As Worksheet
    
    Set shSource = Worksheets("Latest Data")
    Set shDest = Worksheets("B&G SAP DL")
    
    With shSource.Range("A1").CurrentRegion
        Set rgSource = .Offset(1).Resize(.Rows.Count - 1)
    End With
    
    Set rgDest = shDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    
    rgSource.Copy Destination:=rgDest

End Sub

 

[jimbogarner]

Thanks, I don't really understand macros to be honest so the initial macro I was doing may have been massively overcomplicating things! I will give that a go shortly and let you know the outcome

Thanks

 

[jimbogarner]

That worked perfect thanks very much

 

[jimbogarner]

Sorry, next step of the macro... once the data has pasted in, I want it to then copy down the formulas in Column's F & Q-S from the 2nd screenshot above to the bottom of the new text that has been added?