I now understand what you need. Have you gotten a satisfactory result yet?
From: Rajan_Verma
Sent: Wednesday, August 10, 2011 9:45 AM
To: excel-macros@googlegroups.com
Subject: RE: $$Excel-Macros$$ Macro copy filter data in a new sheet
Please Ignore Previous Mail..
See if it helps
Option Base 1
Sub GetData()
Application.ScreenUpdating = False
Dim EmpSh As Worksheet
Dim MappingSheet As Worksheet
Dim EmpName As Range
Dim EmpNameRange As Range
Dim EmpDesigNation As String
Dim Fields As Range
Dim Field As Range
Dim Group() As Variant
Dim i_Counter As Integer
Dim Dbsheet As Worksheet
Dim sumTotalHour As Integer
Dim SumActualHour As Integer
Dim cell As Range
Dim Outputsheet As Worksheet
Dim Country As String
Set EmpSh = Sheets("Employee Name")
Set EmpNameRange = EmpSh.Range("A2:A" & EmpSh.UsedRange.Rows.Count)
Set Dbsheet = Sheets("Database")
Set MappingSheet = Sheets("Mapping")
Set Outputsheet = Sheets("Output")
EmpSh.Activate
Set Fields = MappingSheet.Range("A1").Resize(1,
MappingSheet.UsedRange.Columns.Count)
For Each EmpName In EmpNameRange
EmpDesigNation = EmpName.Offset(0, 1).Value
Country = EmpName.Offset(0, 2).Value
MappingSheet.Activate
For Each Field In Fields
If Field.Value = EmpDesigNation Then
MappingSheet.Range("A1").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$46").AutoFilter
Field:=Field.Column, Criteria1:=EmpName
ActiveSheet.Range("$A$1:$E$46").AutoFilter
Field:=1, Criteria1:=Country
MappingSheet.Range("B2:B" &
Range("b2").End(xlDown).Row).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
MappingSheet.Range("B" &
MappingSheet.UsedRange.Rows.Count + 10).Select
Selection.PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.RemoveDuplicates 1
ReDim Group(Selection.Cells.Count)
For i_Counter = 1 To UBound(Group)
Group(i_Counter) =
Selection.Cells(i_Counter, 1).Value
Next
Selection.EntireRow.Delete
Dbsheet.Activate
sumTotalHour = 0
SumActualHour = 0
For i_Counter = 1 To UBound(Group)
ActiveSheet.Range("$A$1:$D$46").AutoFilter Field:=2, Criteria1:=Group(i_Counter)
ActiveSheet.Range("$A$1:$D$46").AutoFilter Field:=1, Criteria1:=Country
Set rngtotalhour =
Dbsheet.Range("C2:C" &
Range("C2").End(xlDown).Row).Cells.SpecialCells(xlCellTypeVisible)
Set RngactualHour =
Dbsheet.Range("D2:D" &
Range("D2").End(xlDown).Row).Cells.SpecialCells(xlCellTypeVisible)
sumTotalHour = sumTotalHour
+ WorksheetFunction.Sum(rngtotalhour)
SumActualHour =
SumActualHour + WorksheetFunction.Sum(RngactualHour)
Next
Outputsheet.Activate
Outputsheet.Range("A" &
Range("A" & Rows.Count).End(xlUp).Row + 1).Select
ActiveCell.Value = EmpName
ActiveCell.Offset(0,
1).Value = sumTotalHour
ActiveCell.Offset(0,
2).Value = SumActualHour
End If
Next
Next
Application.ScreenUpdating = True
End Sub
From: excel-macros@googlegroups.com [mailto:excel-macros@googlegroups.com] On
Behalf Of Simran Singh
Sent: Wednesday, August 10, 2011 8:39 AM
To: excel-macros@googlegroups.com
Subject: $$Excel-Macros$$ Macro copy filter data in a new sheet
Hello EXPERTS
I have a workbook wherein there are thee sheets (Database, Mapping & Employee
Name). In the Database sheet, I pull out the data from the tool and put that
data in Database sheet. The mapping sheet consist a list of employee who are
basically associated with one group or more than one groups. And in the last
sheet Employee Name is the data for which i have to take out data from the
Database sheet. So what I want basically is :-
1.. Macro to go in the sheet Employee Name and check for the name for which
it has to filter the data.
2.. After taking the details from the Employee Name sheet it comes to the
Mapping sheet and check for the group or groups a employee is associated with.
3.. After this macro should come to the Database sheet and filter the data
according to group or groups which it has got in the Mapping sheet.
4.. After filter it should copy the Total Hours and Actual Hours data from
there and paste in the Output sheet.
Sorry I cannot give you the actual data, but I am attaching the dummy data for
your reference.
Thanks in advance
Regards,
Simran Singh
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
