copying in one work book and pasting in the other

[liam1289]

the user has to select a room and iv to copy what classes it has and paste them into a new workbook but i keep getn error msg can anyone help
here is the code
Private Sub CommandButton2_Click()

Dim r, block As Range
Dim room As String
Dim ws As Worksheet
Const maxhours = 9

room = InputBox("Please enter Room") 'inputbox
For Each work In ActiveWorkbook.Worksheets
With ws
Cells.Find(What:="room").Activate

For block = 1 To maxhours 'loop down from the room number 9 hours in the day
For Each r In block
r.Activate

Selection.Copy
Windows("Room.XLS").Activate
ActiveSheet.Paste
Windows("Final.XLS").Activate
Next r

ws.Activate

Next ws


End Sub

 

[VoG]

Maybe something like this

Private Sub CommandButton2_Click()
Dim room As String
Dim ws As Worksheet
Dim Found As Range
Const maxhours = 9
room = InputBox("Please enter Room") 'inputbox
For Each ws In ActiveWorkbook.Worksheets
    With ws
        Set Found = .Cells.Find(What:="room")
        If Not Found Is Nothing Then
            Found.Offset(1).Resize(maxhours).Copy Destination:=Workbooks("Room.XLS").Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    End With
Next ws
End Sub

 

[liam1289]

im getin an error subscribe out of range



Private Sub CommandButton2_Click()
Dim Class, Room As String
Dim Time, q As Integer
Dim r As Range
Const TotalTimes = 9

Room = InputBox("Please enter a room")
Set r = Cells.Find(What:=Room)
r.Activate
For Each ws In ActiveWorkbook.Worksheets
With ws
For Time = 1 To TotalTimes
r.Activate
Set r = r.Offset(1, 0)
r.Activate
Selection.Copy
Windows("Room.XLS").Activate
ActiveSheet.Paste
Windows("Final.XLS").Activate

Next Time

End With
Next ws
End Sub

 

[VoG]

That indicates that a workbook (probably) does not exist, is mis-spelt etc.

As post #2 shows, you should not need to activate/select anything.

Note that

Dim A, B as Integer

declares A as Variant and B as Integer

Avoid using VBA keywords like Time as variable names.

 

[VoG]

Sorry, in post #2 it should be

        Set Found = .Cells.Find(What:=room)

(no quotes).

 

[liam1289]

what do you mean.i keep getting this error message and cant fix it

 

[VoG]

If the error message is 9 subscript out of range it means that something in your code (like a workbook) does not exist or is not open.

If you try to activate a cell on a sheet that is not the active sheet you will get an error. But see how to avoid selecting above.

Is this homework?

 

[liam1289]

no im trying to learn vb and doing a few different projects but im struggling a bit. here is the code iv done

Private Sub CommandButton2_Click()
Dim Class, Room As String
Dim block, q As Integer
Dim r As Range
Const TotalTimes = 9

Room = InputBox("Please enter a room")
Set r = Cells.Find(What:=Room)
r.Activate
For Each ws In ActiveWorkbook.Worksheets
With ws
For block = 1 To TotalTimes
r.Activate
Set r = r.Offset(1, 0)
r.Activate
Selection.Copy
ChDir "F:\New Folder (3)"
Workbooks.Open Filename:="F:\New Folder (3)\room.XLS"
Windows("Room.XLS").Activate
ActiveSheet.Paste

Windows("Final.XLS").Activate

Next block

End With
Next ws
End Sub

 

[VoG]

And you clearly have taken no notice whatsoever of what I posted here http://www.mrexcel.com/forum/showpost.php?p=2702168&postcount=2 and in subsequent posts.

No doubt that your code fails.

 

[liam1289]

i have tried some of your code but im getting errors on both mine and yours...
im real strugling with this now...can anyone help