Saving copy of data and then running macro on all active worksheets in saved copy?

Hi all,

First off, thanks in advance for all your help. I currently have about 81,000 asc files (essentially tables) that I would like to compile together in sets of three (I haven't even gotten to that step yet). Each contain latitude, longitude, and a methane column reading that I would like to merge into one excel file. For example (3 was skipped):

20030108_1CH4.asc
20030108_1LAT.asc
20030108_1LONG.asc
20030108_2CH4.asc
20030108_2LAT.asc
20030108_2LONG.asc
20030108_4CH4.asc
20030108_4LAT.asc
20030108_4LONG.asc
...

I wanted to merge all the 1s into 3 columns in one worksheet, the 2s into 3 columns in a second, etc. However, I wanted to have a backup of the original worksheet since you can't undo a macro, but for some reason the For Next loop isn't working; it tries to redo the macro on the same worksheet.

Sub WorksheetLoop()
Dim Current As Worksheet

ActiveSheet.Copy
With ActiveWorkbook
.SaveAs "C:\AdvRS" & .Sheets(1).Name
.Close 0
End With


' Loop through all of the worksheets in the active workbook.

For Each Current In Worksheets

If ActiveSheet.Name Like "*LAT" Then
Rows("1:1").Delete
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
":", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers _
:=True

Dim I As Long, k As Long, j As Integer
Application.ScreenUpdating = False
Columns(1).Insert
I = 0
k = 1
While Not IsEmpty(Cells(k, 2))
j = 2
While Not IsEmpty(Cells(k, j))
I = I + 1
Cells(I, 1) = Cells(k, j)
Cells(k, j).Clear
j = j + 1
Wend
k = k + 1
Wend
Application.ScreenUpdating = True
Rows("1:1").Insert
Range("A1") = "LAT"
Else
If ActiveSheet.Name Like "*CH4" Then
Rows("1:1").Delete
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
":", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers _
:=True


Application.ScreenUpdating = False
Columns(1).Insert
I = 0
k = 1
While Not IsEmpty(Cells(k, 2))
j = 2
While Not IsEmpty(Cells(k, j))
I = I + 1
Cells(I, 1) = Cells(k, j)
Cells(k, j).Clear
j = j + 1
Wend
k = k + 1
Wend
Application.ScreenUpdating = True
Rows("1:1").Insert
Range("A1") = "CH4"
Else
If ActiveSheet.Name Like "*LONG" Then
Rows("1:1").Delete
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
":", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers _
:=True


Application.ScreenUpdating = False
Columns(1).Insert
I = 0
k = 1
While Not IsEmpty(Cells(k, 2))
j = 2
While Not IsEmpty(Cells(k, j))
I = I + 1
Cells(I, 1) = Cells(k, j)
Cells(k, j).Clear
j = j + 1
Wend
k = k + 1
Wend
Application.ScreenUpdating = True
Rows("1:1").Insert
Range("A1") = "Long"
Else
MsgBox "This is not a LAT/LONG/CH4 table!"
End If
End If
End If


Next


End Sub


PS Sorry for the wacky formatting; I was using Notepad and probably forgot to turn off the word wrap option. Thanks again!