VBA Macro to Append numerous specified sheets to a master sheet

[mjcalderone3]

First time poster, long-time user. I have a VBA that I have been able to peice together to closely fit my needs. I have a file that has numerous sheets (30), I want select specified sheets to append each other on the "Stats Upload" (Master) sheet. The selected sheets have identical format. Currenly my macro requires me to delete the "Stat Upload" sheet rather than just replacing/overriding the data on the "Stats Upload" sheet when when I have any change on the selected sheets. This "Stats Upload" tab is linked to other things so this part of the macro is causing me a problem; I want the macro to replace the data on the "Stats Upload' tab to not #REF my formulas which it is linked.

Also, the macro is currently pulling the heading into the "Stats Upload" file which I do not want. I only want the data. Which part of the macro can I discard to not pull the header into "Stats Upload" file. "400030 SL Stats Upload 2013" appears to be the tab that the macro is using to pull the header.

I have specified the sheet names within the macro that I want appended. The macro will be reused in numerous files once I get it tied-down; only the sheet names will have to be changed.

The macro that I am working with is below. Your assistance is greatly appreciated.

Sub StatsUpload()
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Stats Upload Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
Set wrk = ActiveWorkbook 'Working in active workbook
For Each sht In wrk.Worksheets
If sht.Name = "Stats Upload" Then
MsgBox "There is a worksheet called as 'Stats Upload'." & vbCrLf & _
"Please remove or rename this worksheet since 'Stats Upload' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht
'We don't want screen updating
Application.ScreenUpdating = False
'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
'Rename the new worksheet
trg.Name = "Stats Upload"
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets("400030 SL Stats Upload 2013")
colCount = sht.Cells(1, 255).End(xlToLeft).Column
'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
'Set font as bold
.Font.Bold = True
End With
'
'
'
Dim i As Long
Dim ShtNames
ShtNames = Array("400030 SL Stats Upload 2013", "400070 SL Stats Upload 2013", "400080 SL Stats Upload 2013", "400165 SL Stats Upload 2013", "400170 SL Stats Upload 2013", "400180 SL Stats Upload 2013", _
"400235 SL Stats Upload 2013", "400240 SL Stats Upload 2013", "400430 SL Stats Upload 2013", "400490 SL Stats Upload 2013", "400550 SL Stats Upload 2013", _
"400570 SL Stats Upload 2013", "400600 SL Stats Upload 2013", "400605 SL Stats Upload 2013", "400610 SL Stats Upload 2013", "400630 SL Stats Upload 2013", "400770 SL Stats Upload 2013", _
"400810 SL Stats Upload 2013")
'We can start loop
For i = LBound(ShtNames) To UBound(ShtNames)
Set sht = Worksheets(ShtNames(i))
'
'
'
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
'Put data into the Stats Upload worksheet
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next i
'Fit the columns in Stats Upload worksheet
trg.Columns.AutoFit
'Screen updating should be activated
Application.ScreenUpdating = True
End Sub

 

[mjcalderone3]

Please help. I am stuck trying to tailor my macro to my needs

 

[bertie]

Hi, and welcome to the forum.

Can I please ask that you use code tags when posting code. This preserves indents and makes the code easier to read.

[CODE ]

code goes here​

[/CODE ]

Here is how I would approach your problem.

I have assumed the worksheets to process are stored on a sheets named Sheet Names.

Sheet Names

*	A
Sheet2
Sheet3
Sheet4

<tbody>
[TD="bgcolor: #cacaca, align: center"]1[/TD]

[TD="bgcolor: #cacaca, align: center"]2[/TD]

[TD="bgcolor: #cacaca, align: center"]3[/TD]

</tbody>

First of all the code calls a procedure to populate the array of sheet names, based on the contents of the above sheet.

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] PopulateSheetNamesArray([COLOR=darkblue]ByRef[/COLOR] arr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR])
   [COLOR=darkblue]Dim[/COLOR] rw [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   
   [COLOR=darkblue]With[/COLOR] Sheets("Sheet Names")
      rw = .Range("A" & Rows.Count).End(xlUp).Row
      arr = .Range("A1:A" & rw).Value
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Then the code calls a procedure to clear the contents, preserving formula, of the stats upload sheet.
NB This may need editing to meet your needs.

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] ClearStatsUpload()
   [COLOR=darkblue]Dim[/COLOR] rw [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] col [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
   
   [COLOR=darkblue]With[/COLOR] Sheets("Stats Upload")
      rw = .Cells(Rows.Count, 1).End(xlUp).Row
      col = .Cells(1, Columns.Count).End(xlToLeft).Column
      .Range(Cells(2, 1), Cells(rw, col)).SpecialCells(xlCellTypeConstants).ClearContents
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Then the code loops through the array of sheet names;
determines the number of rows and columns in the worksheet used range;
finds the row to paste into on the stats upload sheet;
and copies and pastes.

NB Again this may need working on to meet your needs.

Make a copy of you workbook before testing the code.

[COLOR=darkblue]Sub[/COLOR] ProcessStatsUpload()
   [COLOR=darkblue]Dim[/COLOR] rw [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]             [COLOR=green]'row count[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] col [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]            'column count
   [COLOR=darkblue]Dim[/COLOR] rowPaste [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]       [COLOR=green]'paste row in Stats Upload sheet[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] wsStats [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]              [COLOR=green]'worksheet loop index[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] arrSheets [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]   [COLOR=green]'array of sheet names[/COLOR]
   
   ClearStatsUpload
   PopulateSheetNamesArray arrSheets
   
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errExit
   
   [COLOR=darkblue]Set[/COLOR] wsStats = Sheets("Stats Upload")


   [COLOR=green]'loop through the worksheets[/COLOR]
   [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arrSheets) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arrSheets)
      [COLOR=darkblue]Set[/COLOR] ws = Sheets(arrSheets(i, 1))
      
      [COLOR=green]'get the row and column range of the sheet[/COLOR]
       rw = ws.Cells(Rows.Count, 1).End(xlUp).Row
       col = ws.Cells(1, Columns.Count).End(xlToLeft).Column
      
      [COLOR=green]'and the Stats Upload sheet[/COLOR]
       rowPaste = wsStats.Range("A" & Rows.Count).End(xlUp).Row


      [COLOR=green]'copy and paste[/COLOR]
       ws.Range(ws.Cells(2, 1), ws.Cells(rw, col)).Copy _
         Destination:=wsStats.Range("A" & rowPaste + 1)
   
      Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
      [COLOR=darkblue]Set[/COLOR] ws = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Next[/COLOR] i
   
errExit:
   [COLOR=darkblue]Set[/COLOR] ws = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsStats = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[edwincastellino]

Hi,

Need your help with a macro which auto populates the following tables when I select any folders and it auto populates the properties of ALL the files in the folder and sub folders in the following table.
[TABLE="class: grid, width: 20"]
<tbody>[TR]
[TD]File Name
[/TD]
[TD]Folder Path
[/TD]
[TD]File Type <Excel / Word etc>
[/TD]
[TD]Date when Created
[/TD]
[TD]Date When Last Saved
[/TD]
[TD]Date when the file was printed
[/TD]
[TD]Name of Person who printed the file
[/TD]
[TD]File is "Read Only" <Yes/No>
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Apart from the above... for all Excel files a new sheet should populate all the sheet names in cells one below the other and populate the contents of the right header / centre header / left header and footers available in the sheets

 

[Michael M]

@edwincastellino
Please start a new thread if you have a question.
Jumping onto to another persons thread is called Thread Hijacking is frowned upon