Merging Modules

[margolis22]

I have the following code that mostly works but I need some
additional assistance to complete it.

1st set of code finds the last worksheet : it works well

2nd set of code should copy the current worksheet (last one found fro
previous code) to new worksheet that is placed at the end and names th
worksheet for me. : It creates a new worksheet at the end but does no
copy the last worksheet

3rd set of code should copy Columns K to I. : I need help to have
this use the current worksheet. Currently it uses a static worksheet.

Thanks, JGM


Sub GotoLastSheet()
Dim i&
For i = Sheets.Count To 1 Step -1 ' Counting
backwards
If Sheets(i).Visible And TypeName(Sheets(i)) <> "Module" Then
Sheets(i).Select
Exit Sub
End If
Next i
End Sub



Sub NextTab()
' Load array with month abbreviations
Dim Months(12)
For X = 0 To 11
Months(X) = MonthName(X + 1, True)
Next X
Months(12) = "Jan"
' Determine current and new month / year values
CurMo = Left(ActiveSheet.Name, 3)
CurYr = Right(ActiveSheet.Name, 2)
NextMo = Months(Application.WorksheetFunction.Match(CurMo, Months, 0))
NextYr = CurYr
' Add 1 to the year if current month is December
If CurMo = "Dec" Then NextYr = NextYr + 1
TabName = NextMo & Right("00" & NextYr, 2)
' Add and name new worksheet
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = TabName
End Sub

Sub KtoI()
'
' KtoI Macro
' Macro recorded 01/29/2004 by Lanier Worldwide
'
' Keyboard Shortcut: Ctrl+k
'

Sheets("Feb04").Copy After:=Sheets(14)

ActiveWindow.SmallScroll Down:=240
ActiveWindow.LargeScroll Down:=-8
Columns("K:K").Select
Selection.Copy
Columns("I:I").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("A5").Select
End Su

 

[Dave Peterson]

In the NextTab routine, you're just adding a new worksheet:

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

maybe this would do it for you:

ActiveSheet.Copy _
After:=Worksheets(Worksheets.Count)

But it assumes the want the activesheet copied. (It looked that way to me.)

And for the third routine:

Sub KtoI()
With ActiveSheet
.Columns("K:K").Copy
.Columns("i:i").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False

End Sub


==============

But I think you could all of this with less selecting/activating in one
procedure:

Option Explicit
Sub AllAtOnce()

Dim i As Long
Dim curWks As Worksheet
Dim testStr As String
Dim testYear As String
Dim testMonth As String
Dim testWks As Worksheet

Dim nextMonth As String
Dim tempDate As Date
Dim nextWks As Worksheet

For i = Sheets.Count To 1 Step -1 ' Counting backwards
If Sheets(i).Visible And TypeName(Sheets(i)) = "Worksheet" Then
Set curWks = Sheets(i)
Exit For
End If
Next i

testStr = curWks.Name
If Len(testStr) <> 5 Then
MsgBox "Not on a Month/Year worksheet!"
Exit Sub
End If

testMonth = Left(testStr, 3)
If Right(testStr, 2) > "30" Then
testYear = "19" & Right(testStr, 2)
Else
testYear = "20" & Right(testStr, 2)
End If

testStr = testMonth & " 1, " & testYear

If IsDate(testStr) = False Then
MsgBox "Not a valid month/year worksheet"
Exit Sub
End If

tempDate = CDate(testStr)
tempDate = DateSerial(Year(tempDate), Month(tempDate) + 1, 1)

nextMonth = Format(tempDate, "MMMYY")

Set testWks = Nothing
On Error Resume Next
Set testWks = Worksheets(nextMonth)
On Error GoTo 0

If testWks Is Nothing Then
'keep going
Else
MsgBox nextMonth & " already exists--something bad happened!"
Exit Sub
End If


curWks.Copy _
after:=Worksheets(Worksheets.Count)
Set nextWks = ActiveSheet

With nextWks
.Name = nextMonth
.Columns("K:K").Copy
.Columns("i:i").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

Application.CutCopyMode = False

End Sub