Using Range Information


Posted by In Trouble on October 03, 2001 9:04 PM

Hi

I hope someone can help, I have created some code that copies the currently selected sheet name to a sheet called 'Sheet3' where it forms a list starting in cell A1. This range increases whenever a sheet is selected that is not already in the list.

ie

Public Sub sheetChanged()
Dim Ws As Worksheet
Dim i As Integer
Set Ws = Worksheets("Sheet3")
If Trim(Ws.Cells(1, 1)) <> "" Then
If Not found(ActiveSheet.Name, i) Then
Ws.Cells(i, 1) = ActiveSheet.Name
End If
Else
Ws.Cells(1, 1) = ActiveSheet.Name
End If
End Sub

Function found(Val As String, i As Integer) As Boolean
found = False
Dim j
j = 1
While Trim(Worksheets("Sheet3").Cells(j, 1)) <> ""
If Worksheets("Sheet3").Cells(j, 1) = Val Then
found = True
Exit Function
End If
j = j + 1
Wend
i = j
End Function

At the momentI have setup a macro that currently copies data from one row to the first free row of the current sheet. However I then have to move to the next sheet and run the macro again. What I would like to do is automate this process so it looks at the list generated in the Sheet3 worksheet and runs the macro on all the sheet names within the list.

What code do I need to pass the information?, I currently have some test code underneath which works to a point, It will find the sheet names, but will not pass the information to the 'Worksheets(c).Select' line variable c always seems to remain empty yet on the code line above it registers it as Sheet2 for example, so it is looking down the list, it just seems not to work for the Worksheets(c).Select line

Sub Mange()

For Each c In Worksheets("sheet3").Range("Fifty")
If c = "" Then Exit Sub
Worksheets(c).Select
Rows("1:1").Select
Selection.Copy
Rows("3:3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Next c
MsgBox "End"
End Sub



Posted by Robb on October 04, 2001 3:40 AM

I'm not sure your code will actually do what you said it should. Rather than copying
data from one row to the "first free row", it will copy data from Row1 to Row3.

Anyway, I've amended it and it should work:

Sub Mange()

For Each c In Worksheets("sheet3").Columns(1).Cells
If c = "" Then GoTo Complete
Dim shName
shName = c
Worksheets(shName).Select
Rows(1).Select
Selection.Copy
Rows(3).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Cells(3, 1).Select
Next c
Complete:
MsgBox "End"
End Sub

However, if you need it to copy Row1 to the first free row on the same sheet,
try this instead:

Sub Mange2()

For Each c In Worksheets("sheet3").Columns(1).Cells
If c = "" Then GoTo Complete
Dim shName
shName = c
Worksheets(shName).Select
Rows(1).Select
Selection.Copy
Dim nextR As Integer
nextR = ActiveSheet.UsedRange.Rows.Count + 1
Rows(nextR).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Cells(nextR, 1).Select
Next c
Complete:
MsgBox "End"
End Sub

Any help?

Regards