PDA

View Full Version : macro code to switch worksheets?



hrakowski
07-05-2009, 07:19 PM
I'm working on a very basic simple macro in an excel 2007 document. I recorded the macro to take the data from one row in one tab and insert it into another cell in a different tab. Now I am looking for the code to get the macro to run from row 1 data in tab "a" to switch to row 2 data in the next tab "b" and so on.

I'm pulling data from tab "students" which has 200 unique rows. I have created a tab with each student's name and now I need to merge the data from row 1 into student1's tab, and row 2 into student2's tab, and row 3 into student3's tab, etc, etc.

Thanks for any help in advance.
-Hadley

rbrhodes
07-05-2009, 09:57 PM
Hi Hadley,

Welcome to VBX.

Are these rows and tabs in order? Row 1 = Tab 1, etc.?

That would, of course, be easiest. But not foolproof.

Perhaps post a small example of what you have and what you want.

Bob Phillips
07-06-2009, 01:03 AM
Maybe something like


Dim LRowMaster As Long
Dim LRowStudent As Long
Dim shStudent As Worksheet
Dim i As Long

With Worksheets("Students")

LRowMaster = .Range("A1").End(xlDown).Row
For i = 1 To LRowMaster

'assumes student name in column A
Set shStudent = Worksheets(.Cells(i, "A").Value)
LRowStudent = shStudent.Range("A1").End(xlDown)
.Rows(i).Copy shStudent.Cells(LRowStudent + 1, "A")
Next i
End With

hrakowski
07-06-2009, 04:39 AM
Yes they are in order :). I will try the code above and let you know.

Thanks,
Hadley

aravindhan_3
07-06-2009, 06:12 AM
Try this.. Sub Filter()
Dim sWS As Worksheet
Dim Students As Range, Student As Range
Dim lRow As Long, fRow As Integer
Dim CopyRng As Range, ws As Worksheet
Set sWS = Worksheets("Data") '- your sheet name
lRow = sWS.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
sWS.Columns(1).Insert
sWS.Range("B1:B" & lRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=sWS.Range("A1"), Unique:=True
fRow = sWS.Range("A" & Rows.Count).End(xlUp).Row
Set Students = sWS.Range("A2:A" & fRow)
For Each Student In Students
With sWS.Range("B1:B" & lRow)
.AutoFilter Field:=1, Criteria1:=Student
Set CopyRng = .Offset(0, 0).Resize(.Rows.Count + 1, Columns.Count - 1). _
SpecialCells(xlCellTypeVisible)
On Error Resume Next
Set ws = Sheets(Student.Value)
On Error GoTo 0
If Not ws Is Nothing Then
CopyRng.Copy
ws.Range("A1").PasteSpecial xlPasteAll

'ws.Cells(Rows.Count, 9).End(xlUp).Font.Bold = True
Else
Set ws = Sheets.Add
ws.Name = Student.Value
CopyRng.Copy
ws.Range("A1").PasteSpecial xlPasteAll
' ws.Cells(Rows.Count, 9).End(xlUp).Font.Bold = True
End If
.AutoFilter
End With
Set ws = Nothing
Set CopyRng = Nothing
Next Student
sWS.Columns(1).Delete
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Dim wkSt As String
Dim wkBk As Worksheet
wkSt = ActiveSheet.Name
For Each wkBk In ActiveWorkbook.Worksheets
On Error Resume Next
wkBk.Activate
Range("A1").Select
Next wkBk
Sheets(wkSt).Select
Application.ScreenUpdating = True
End Sub


I would prefer xlds...

cheers
Arvind