copying in one work book and pasting in the other

VoG

Legend

Joined

Jun 19, 2002

Messages

63,650

• May 1, 2011

• #2

Maybe something like this

Code:

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

 

Upvote 0

L

liam1289

New Member

Joined

Apr 27, 2011

Messages

16

• May 1, 2011

• #3

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

 

Upvote 0

VoG

Legend

Joined

Jun 19, 2002

Messages

63,650

• May 1, 2011

• #4

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.

 

Upvote 0

VoG

Legend

Joined

Jun 19, 2002

Messages

63,650

• May 1, 2011

• #5

Sorry, in post #2 it should be

Rich (BB code):

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

(no quotes).

 

Upvote 0

L

liam1289

New Member

Joined

Apr 27, 2011

Messages

16

• May 1, 2011

• #6

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

 

Upvote 0

VoG

Legend

Joined

Jun 19, 2002

Messages

63,650

• May 1, 2011

• #7

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?

 

Upvote 0

L

liam1289

New Member

Joined

Apr 27, 2011

Messages

16

• May 1, 2011

• #8

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

 

Upvote 0

VoG

Legend

Joined

Jun 19, 2002

Messages

63,650

• May 1, 2011

• #9

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.

 

Upvote 0

L

liam1289

New Member

Joined

Apr 27, 2011

Messages

16

• May 1, 2011

• #10

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

 

Upvote 0