B
butrfly_kis3
I am trying to create a macro based on a summary sheet with the field
description-there are options to insert extra lines if needed, however
at each description entered I want to have it insert a range called
"Worksheet" with each description being placed in the first row.
IE Summary sheet-
(Description column)
Example 1
Example 2
Example 3
Example 4
Worksheet 1
(Description Column)
Example 1
Worksheet 2
(Description Column)
Example 2
Worksheet 3
(Description Column)
Example 3
Worksheet 4
(Description Column)
Example 4
So far this is the code I have created:
Sub Insert_Worksheets()
Dim R As Integer
Dim Sum_Description As String
Dim Worksheet_Num As Integer
Dim N As Integer
Dim First_Cell As Range
Dim J As Integer
Range("First_Cell") = Worksheets("Summary").Columns("C").Rows("7")
Range("First_Cell").Activate
R = 7
N = 1
Range("Worksheet_Num") = N
Application.ScreenUpdating = False
Do Until (IsEmpty(Cells(R, 3)))
If Range("Sum_Description") = " " Then
Range("Worksheet").Copy
Range("Summary_Sheet").Insert shift:=xlShiftDown,
copyorigin:=True
Range("Sum_Description").Select
Selection.Copy
Range("Description").PasteSpecial xlPasteValues,
xlPasteSpecialOperationNone
R = R + 22
N = N + 1
Range("Worksheet_Num") = N
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
I am also attaching the file so you can have a visual on what I am
trying to accomplish.
Thanks in advance.
+-------------------------------------------------------------------+
|Filename: Summary Sheet1.xlsm |
|Download: http://www.thecodecage.com/attachment.php?attachmentid=4 |
+-------------------------------------------------------------------+
description-there are options to insert extra lines if needed, however
at each description entered I want to have it insert a range called
"Worksheet" with each description being placed in the first row.
IE Summary sheet-
(Description column)
Example 1
Example 2
Example 3
Example 4
Worksheet 1
(Description Column)
Example 1
Worksheet 2
(Description Column)
Example 2
Worksheet 3
(Description Column)
Example 3
Worksheet 4
(Description Column)
Example 4
So far this is the code I have created:
Sub Insert_Worksheets()
Dim R As Integer
Dim Sum_Description As String
Dim Worksheet_Num As Integer
Dim N As Integer
Dim First_Cell As Range
Dim J As Integer
Range("First_Cell") = Worksheets("Summary").Columns("C").Rows("7")
Range("First_Cell").Activate
R = 7
N = 1
Range("Worksheet_Num") = N
Application.ScreenUpdating = False
Do Until (IsEmpty(Cells(R, 3)))
If Range("Sum_Description") = " " Then
Range("Worksheet").Copy
Range("Summary_Sheet").Insert shift:=xlShiftDown,
copyorigin:=True
Range("Sum_Description").Select
Selection.Copy
Range("Description").PasteSpecial xlPasteValues,
xlPasteSpecialOperationNone
R = R + 22
N = N + 1
Range("Worksheet_Num") = N
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
I am also attaching the file so you can have a visual on what I am
trying to accomplish.
Thanks in advance.
+-------------------------------------------------------------------+
|Filename: Summary Sheet1.xlsm |
|Download: http://www.thecodecage.com/attachment.php?attachmentid=4 |
+-------------------------------------------------------------------+