I do not have experience with macros. I copied and tweaked code to produce a consolidated/appended "Summary" sheet from 12 worksheets and it pastes in a header (2 rows worth) and formatting at the end. As far as I can tell, the "Summary" sheet is producing & updating what I want correctly every time I run the macro.
I created a pivot table on a separate sheet, same workbook. The Data Source for my pivot table is tied to "Summary" cells A2:J5000.
When I rerun the macro to update my "Summary" sheet, then hit "Refresh" on my pivot table, I receive an error about my name field not being valid and needing labeled columns.
I go to edit the pivot Data Source directly and it shows it as A3:J5001 instead of A2:J5000.
Each time I run the macro, the data source for the pivot table goes down one more row unless I manually reset it to what I want.
I do not know what to do to fix it. I just want to be able to refresh my pivot table with a single click without needing to fix the Data Source each time.
Thanks in advance for your help and patience.
'Append data from multiple worksheet to single worksheet macro
Sub CombineData()
Dim wksFirst As Worksheet
Dim wksLast As Worksheet
Dim wksDest As Worksheet
Dim strFirstSht As String
Dim strLastSht As String
Dim strDestSht As String
Dim NextRow As Long
Dim i As Long
strFirstSht = "Jan" 'change the name of the first sheet accordingly
strLastSht = "Dec" 'change the name of the last sheet accordingly
strDestSht = "Summary" 'change the name of the destination sheet accordingly
On Error Resume Next
Set wksFirst = Worksheets(strFirstSht)
If wksFirst Is Nothing Then
MsgBox strFirstSht & " does not exist...", vbInformation
Exit Sub
Else
Set wksLast = Worksheets(strLastSht)
If wksLast Is Nothing Then
MsgBox strLastSht & " does not exist...", vbInformation
Exit Sub
End If
End If
On Error GoTo 0
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(strDestSht).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set wksDest = Worksheets.Add(Worksheets(1))
wksDest.Name = strDestSht
For i = wksFirst.Index To wksLast.Index
Worksheets(i).Range("A3:J500").Copy
With wksDest
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
With .Cells(NextRow, "A")
.PasteSpecial PASTE:=8 'column width for Excel 2000 and later
.PasteSpecial PASTE:=xlPasteValues
.PasteSpecial PASTE:=xlPasteFormats
End With
End With
Next i
wksDest.Cells(1).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
' HEADER Macro
'
'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C19").Select
' PASTE Macro
'
'
Sheets("Jan").Select
Range("A1:J1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Summary").Select
Range("A1").Select
ActiveSheet.PASTE
Range("A1").Select
Selection.PasteSpecial PASTE:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial PASTE:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Jan").Select
Range("A2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Summary").Select
Range("A2").Select
Selection.PasteSpecial PASTE:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial PASTE:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[2]C:R[4999]C)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[2]C:R[4999]C)"
Range("A2:J2").Select
Selection.AutoFilter
Range("A3").Select
ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add Key:=Range("A3"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Summary").Sort
.SetRange Range("A3:J8")
.HEADER = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D4").Select
'
' TAB_COLOR Macro
'
'
Sheets("Summary").Select
With ActiveWorkbook.Sheets("Summary").Tab
.Color = 65535
.TintAndShade = 0
End With
End Sub
'
Bookmarks