Creating Workbooks from a list.

jay0656

New Member
Joined
May 5, 2011
Messages
3
Hi Guys,

I have created a list form 5 workbooks and now i want to recreate the workbooks again. If any one could help it would be great. Here is the code so far.

Public Sub timetable()
Dim r As Range, start As Range
Dim timetable As Range
Dim up As Integer, hour As Integer, room As Integer, Back As Integer
Dim wb As Workbook, TheFile As String, MyPath As String
Dim time As String, group As String, day As String, classroom As String
Dim year As String
Const maxrooms = 13, maxhours = 9
Range("A2").Activate

MyPath = "C:\Documents and Settings\user\My Documents\Aidan"
ChDir MyPath
TheFile = Dir("*.xls")
Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
Set start = Range("B3")
start.Activate
Set r = start


Set timetable = Range(start, start.Offset(maxhours - 1, maxrooms - 1))
For Each r In timetable
r.Activate
up = r.Row - 2
Back = r.Column - 1

If r.Value <> "" Then classroom = r.Offset(-up, 0).Value

If r.Value <> "" Then time = r.Offset(0, -Back).Value

If r.Value <> "" Then group = r.Value

If r.Value <> "" Then day = ActiveWorkbook.Name

If r.Value <> "" Then
Set yearcheck = ActiveCell
End If

If yearcheck.Value Like "*3" Then
year = 3
ElseIf yearcheck.Value Like "*2" Then
year = 2
ElseIf yearcheck.Value Like "*1" Then
year = 1
Else: year = 1
End If

If r.Value <> "" Then
Windows("Aidan MAster").Activate
ActiveCell.Select
ActiveCell.Value = time
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = classroom
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = group
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = year
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = day
ActiveCell.Offset(1, -4).Activate
wb.Activate





End If

Next r
wb.Close
TheFile = Dir
Loop



End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Forum statistics

Threads
1,224,569
Messages
6,179,605
Members
452,928
Latest member
VinceG

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top