Hi Reinaldo,
Paul Schreiner has already given me a solution that works very well, and that I have adapted to my real workbook.
(you could look at a few posts lower).
But I will try your own solution and come back to you.
Thank you for the time you took to help me with this problem.
Louise
> I'm not sure if i have understood (my english is not good), but try:
>
>
>
> Sub ListSheets()
>
> Dim x As Integer
>
> x = 100
>
> Application.ScreenUpdating = False
>
> For Each sh In Sheets
>
> If sh.Name <> "Source" And sh.Name <> "Problem description" Then
>
> Sheets("source").Range("AA" & x) = sh.Name
>
> If Not IsError(Application.Match(sh.Name, Sheets("Source").Range("B:B"),
> 0)) Then
>
> Sheets("source").Range("AB" & x) = Sheets("source").Range("H" &
> Application.Match(sh.Name, Sheets("Source").Range("B:B"), 0)).Value
>
> Else
>
> Sheets("source").Range("AB" & x) = sh.[a1].Value
>
> End If
>
> x = x + 1
>
> End If
>
> Next
>
> Sheets("Source").Activate
>
> Sheets("Source").Range("AA100:AB" & 100 + Sheets.Count).Select
>
> Sheets("Source").Sort.SortFields.Clear
>
> Sheets("Source").Sort.SortFields.Add Key:=Range( _
>
> "AB100:AB" & 100 + Sheets.Count), SortOn:=xlSortOnValues,
> Order:=xlAscending, DataOption:= _
>
> xlSortNormal
>
> With ActiveWorkbook.Worksheets("Source").Sort
>
> .SetRange Range("AA100:AB112")
>
> .Header = xlGuess
>
> .MatchCase = False
>
> .Orientation = xlTopToBottom
>
> .SortMethod = xlPinYin
>
> .Apply
>
> End With
>
> i = 3
>
> For j = 100 To 100 + Sheets.Count - 2
>
> 'For Each sh In Sheets
>
> nm = Sheets("Source").Range("AA" & j)
>
> If nm <> "" Then
>
> Sheets(nm).Move Before:=Sheets(i)
>
> i = i + 1
>
> End If
>
> Next
>
> Sheets("Source").Range("AA100:AB" & 100 + Sheets.Count).Clear
>
> Sheets("Source").Activate
>
> Application.ScreenUpdating = True
>
> End Sub
>
>
>
>
>
> [Non-text portions of this message have been removed]
>
>
>
> ------------------------------------
>
> ----------------------------------
> Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
>
> ----------------------------------
> Visit our ExcelVBA group home page for more info and support files:
> http://groups.yahoo.com/group/ExcelVBA
>
> ----------------------------------
> More free tutorials and resources available at:
> http://www.mousetrax.com
>
> ----------------------------------Yahoo! Groups Links
>
>
>
| Reply via web post | Reply to sender | Reply to group | Start a New Topic | Messages in this topic (9) |
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar