Phixtit
Active Member
- Joined
- Oct 23, 2008
- Messages
- 346
I have a macro that will copy Sheet, Create & name a new Sheet & Paste sheet to the new Sheet.
When it copies Sheet I need it to move the values in column J and Paste them into Column B.
Here is my module code: (Shown in Red is what I've been trying)
Below is the form code to call the module above:
Any ideas on how this can be accomplished?
When it copies Sheet I need it to move the values in column J and Paste them into Column B.
Here is my module code: (Shown in Red is what I've been trying)
Code:
Sub MyButtons()
Dim CurrentDay As Integer, NewName As String
Dim checkWs As Worksheet, OldWs As Worksheet
Set OldWs = ActiveSheet
ActiveSheet.Unprotect ("1212")
If IsNumeric(Right(ActiveSheet.Name, 2)) Then
CurrentDay = Right(ActiveSheet.Name, 2)
ElseIf IsNumeric(Right(ActiveSheet.Name, 1)) Then
CurrentDay = Right(ActiveSheet.Name, 1)
Else
Exit Sub
End If
If CurrentDay >= 30 Then
MsgBox "You cannot go higher than 30"
Exit Sub
End If
CurrentDay = CurrentDay + 1
NewName = "DAY " & CurrentDay
On Error Resume Next
Set checkWs = Worksheets(NewName)
If checkWs Is Nothing Then
Worksheets(ActiveSheet.Name).Copy After:=Worksheets(ActiveSheet.Index)
With ActiveSheet
.Name = NewName
[COLOR=Red].Range("J7:J1048576").Copy
.Range("B7:B1048576").Paste[/COLOR]
ActiveSheet.Unprotect ("1212")
.Range("S4").Value = Range("S4").Value + 1
.Range("L2").Value = Range("L2").Value + 1
[COLOR=Red].Range("J7:J1048576").Value = Range("B7:B1048576").Paste[/COLOR]
Dim strFrmla As String
strFrmla = Application.ConvertFormula(.Range("S8").Formula, xlA1, xlR1C1, toabsolute:=True)
.Range("S8").FormulaR1C1 = Left(strFrmla, InStrRev(strFrmla, "C")) & CLng(Mid(strFrmla, InStrRev(strFrmla, "C") + 1)) + 1
strFrmla = Application.ConvertFormula(.Range("S9").Formula, xlA1, xlR1C1, toabsolute:=True)
.Range("S9").FormulaR1C1 = Left(strFrmla, InStrRev(strFrmla, "C")) & CLng(Mid(strFrmla, InStrRev(strFrmla, "C") + 1)) + 1
strFrmla = Application.ConvertFormula(.Range("S10").Formula, xlA1, xlR1C1, toabsolute:=True)
.Range("S10").FormulaR1C1 = Left(strFrmla, InStrRev(strFrmla, "C")) & CLng(Mid(strFrmla, InStrRev(strFrmla, "C") + 1)) + 1
strFrmla = Application.ConvertFormula(.Range("V14").Formula, xlA1, xlR1C1, toabsolute:=True)
.Range("V14").FormulaR1C1 = Left(strFrmla, InStrRev(strFrmla, "C")) & CLng(Mid(strFrmla, InStrRev(strFrmla, "C") + 1)) + 1
strFrmla = Application.ConvertFormula(.Range("V15").Formula, xlA1, xlR1C1, toabsolute:=True)
.Range("V15").FormulaR1C1 = Left(strFrmla, InStrRev(strFrmla, "C")) & CLng(Mid(strFrmla, InStrRev(strFrmla, "C") + 1)) + 1
ActiveSheet.Protect ("1212")
End With
Else
Set checkWs = Nothing
MsgBox "A Worksheet named " & NewName & " already exists."
End If
ActiveSheet.Protect ("1212")
OldWs.Protect ("1212")
End Sub
Code:
Private Sub Day2_Click()
Dim TargetSheet As Worksheet
On Error Resume Next
Sheet2.Select
Set TargetSheet = Sheets("Day 2")
On Error GoTo 0
If TargetSheet Is Nothing Then
If MsgBox("Would you like to add a Day?", vbOKCancel) = vbOK Then
Call MyButtons
Unload Me
Else
Exit Sub
End If
MsgBox "You have successfully added a day."
Else
Unload Me
End If
End Sub
