• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA code for selecting excel file through userform and copying data in sheets to new wb sheets

just08in

New Member
Excel gurus,
My requirement is like this
I have a master excel file, with multple sheets of data and some pivot sheets based on those sheets. The common key for each of the data sheets is department. I have 20 departments. I create a copy of the master excel file first then I filter the data sheets for each of the department and delete the rows of the other departments, refresh the pivots and save the excel file under the department name with date and I mail it to the department head listed in the summary sheet in the row of the department. This operation I do for 20 times every day.
After having searched so much in the internet for various excels, I feel it can made easy by using macro. I tried to copy bits of code from each of the searches but am unable to do it.

I have written the below code, to copy all department names in an array IBG
Code:
For Each cell In Range("A2:A16")
 IBG(i) = cell.Value
 i = i + 1
 Next cell

then in the first sheet I am filtering for the particular department and copying the data into one new workbook, while the remaining sheets data also have to added to the same new workbook. also the values have to copied as paste special-values only
Code:
 Sheets("Final_DB").Select
 ActiveSheet.Range("$A$1:$B$16").AutoFilter Field:=1, Criteria1:=IBG(i)
 Application.Goto reference:="Final_IBG_DB"
 Selection.Copy
 Workbooks.Add
 ActiveSheet.Paste
then I need to create pivot tables. My master excel file has the pivot tables with all fields,filters.

Could some one share code for the below logic
1) Loop in the summary sheet, column A has department names, select department name
2) Copy the whole workbook into new workbook
3) Filter each of the data sheets in the new workbook for the selected department and delete the other rows entirely
4) Refresh the pivot tables
5) Save the workbook in the name of the department and date
6) Mail it to the email id listed in the summary sheet against the department name
7) continue the loop till all the departments are done
 
Whoa, lots of little questions! :)

I'll tackle the ones I can answer easily, showing example code/syntax
2)
Code:
Dim NewFileName As String
NewFileName = "C:\My Documents\My File.xlsx"
ThisWorkbook.SaveCopyAs NewFileName

3). Filtering through sheets
Code:
Sub FilterSheets()
Dim ws As Worksheet
Dim myDept As String
myDept = "Admins"

Application.ScreenUpdating = False
'Setup loop through worksheets
For Each ws In ThisWorkbook.Worksheets
    'Find rows that don't match dept
    ws.UsedRange.AutoFilter Field:=1, Criteria:="<>" & myDept
    'Delete all of those rows
    ws.UsedRange.Offset(1).EntireRow.SpecialCells(xlCellTypeVisible).Delete
    'Turn off autofilter
    ws.Cells.AutoFilter
Next ws
Application.ScreenUpdating = True
  
End Sub

4) Refresh all PT's
Code:
ThisWorkbook.RefreshAll

5). Either see #1, or do:
Code:
Dim myPath As String
myPath = ThisWorkbook.Path 'Save in same folder?
ThisWorkbook.SaveAs mypath & "Dept Name" & format(date,"yyyymmdd")
 
Luke..thanks so much, I know I would sound a dummy by asking that many questions.
I am now able to manage it. Thanks so much.
 
Back
Top