Copy Paste from Class Sheet to Filtered List on Combined Sheet

[prkhan56]

Hello All,
I am using Office 2003 and have the following problem.
I have two Sheets viz. Class and Combined

Example of Class Sheet – A1 to P1
S.No Name House DOB Contact Nationality … …. … … …(Headers in
Row 1)
Names and other details are not REPEATED on this Sheet.

Example of Combined Sheet – A1 to H1
S.No Name Class … …. … ….(Headers in Row 1)
Names and other details on this Sheet ARE REPEATED for different
requirements.

Please note that Name (Column B on both sheets) is Unique.

I wish to paste the data of each row against each name in Class Sheet
(Column C to Column P) into Combined Sheet from Column I onwards
against that particular name.
At present I am using Data-Filter on Combined Sheet and copy/pasting
from Class Sheet against the filtered name, which is very time
consuming.

Can a macro lookup the names in Class Sheet from B2 downwards and
copy the data of the row from Column C to Column P and do the Data-
Filter in Combined Sheet for each name and paste the values from
Column I onwards against the filtered names.
Any help would be greatly appreciated

Thanks in advance


Rashid Khan

 

[Joel]

Sub Combinesheets()

With Sheets("Class")
RowCount = 2
Do While .Range("B" & RowCount) <> ""
RowName = .Range("B" & RowCount)
Set c = Sheets("Combine").Columns("B").Find(what:=RowName, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Could not find : " & RowName)
Else
.Range("C" & RowCount & "" & RowCount).Copy _
Destination:=c.Offset(0, 6)
End If
RowCount = RowCount + 1
Loop
End With
End Sub

 

[Joel]

Sub Combinesheets()

With Sheets("Class")
RowCount = 2
Do While .Range("B" & RowCount) <> ""
RowName = .Range("B" & RowCount)
Set c = Sheets("Combine").Columns("B").Find(what:=RowName, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Could not find : " & RowName)
Else
.Range("C" & RowCount & "" & RowCount).Copy _
Destination:=c.Offset(0, 6)
End If
RowCount = RowCount + 1
Loop
End With
End Sub

 

[prkhan56]

Sub Combinesheets()

With Sheets("Class")
   RowCount = 2
   Do While .Range("B" & RowCount) <> ""
      RowName = .Range("B" & RowCount)
      Set c = Sheets("Combine").Columns("B").Find(what:=RowName, _
         LookIn:=xlValues, lookat:=xlWhole)
      If c Is Nothing Then
         MsgBox ("Could not find : " & RowName)
      Else
         .Range("C" & RowCount & "" & RowCount).Copy _
            Destination:=c.Offset(0, 6)
      End If
      RowCount = RowCount + 1
   Loop
End With
End Sub












- Show quoted text -

Hi Joel,
Thanks for the prompt reply.
Your macro copy only in the first name in the CombineSheet.
My requirement is that it should do a Data/Filter and then copy
against the Filtered List...which can be from one to many.

Hope I am clear

Thanks for your time once again.

 

[Joel]

If the Class sheet has duplicate names then the last duplicate will be the
final in the combine sheet. results.

Sub Combinesheets()

With Sheets("Combine")
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
Set SearchRange = .Range("B2:B" & LastRow)
End With
With Sheets("Class")
RowCount = 2
Do While .Range("B" & RowCount) <> ""
RowName = .Range("B" & RowCount)
For Each itm In SearchRange
If itm.Value = RowName Then
.Range("C" & RowCount & "" & RowCount).Copy _
Destination:=itm.Offset(0, 6)
End If
Next itm
RowCount = RowCount + 1
Loop
End With
End Sub

 

[prkhan56]

If the Class sheet has duplicate names then the last duplicate will be the
final in the combine sheet. results.

Sub Combinesheets()

With Sheets("Combine")
   LastRow = .Range("B" & Rows.Count).End(xlUp).Row
   Set SearchRange = .Range("B2:B" & LastRow)
End With
With Sheets("Class")
   RowCount = 2
   Do While .Range("B" & RowCount) <> ""
      RowName = .Range("B" & RowCount)
      For Each itm In SearchRange
         If itm.Value = RowName Then
            .Range("C" & RowCount & "" & RowCount).Copy _
               Destination:=itm.Offset(0, 6)
         End If
      Next itm
      RowCount = RowCount + 1
   Loop
End With
End Sub








- Show quoted text -

Thanks Joel,
I will test it and come back to you.

Rashid

 

[prkhan56]

Thanks Joel,
I will test it and come back to you.

Rashid- Hide quoted text -

- Show quoted text -

Hi Joel,
Works like a charm.
Thanks a million

Rashid Khan