VBA cutting and inserting multiple rows

[JasonBing]

I am trying to code this correctly. Please Help

I am working with data sets taking up 10 rows, no merged cells and all cells the same height, each job list takes up 10 rows.



after selecting 10 rows making up 1 job, I want to cut them and insert them 10 rows up (moving the job above down to take its place)

I hope this makes sense.

I am using

Sub Move_Up()
Selection.Cut
Selection.Offset(-10, 0).Select
Selection.Insert Shift:=xlDown
End Sub

This works really well and there is no problem here.

The problem is when I try to move the job (contained in the 10 rows) down and move the job below up

I really hope this is making sense.

This is not working.

I am using

Sub Move_Dn()
Selection.Cut
Selection.Offset(10, 0).Select
Selection.Insert Shift:=xlDown
End Sub

This just appears to move the selection box down, but no data comes with it.

I need it to be a cut and insert as this data is in a Gantt chart.

I would really appreciate help with this

Thanks

JasonBing

 

[Fluff]

You need to move down 20 rows like

Sub Move_Dn()
Selection.Cut
Selection.Offset(20, 0).Insert Shift:=xlDown
End Sub

Otherwise you paste directly below the existing selection, when is then cut, so the data moves back up to where it started

 

[JasonBing]

Wow. That was a fast reply. you are a dead set legend mate. Thanks works really well

it has been a long day and you have helped me a great deal to get this finished

Thanks

 

[Fluff]

You're welcome & thanks for the feedback

 

[JasonBing]

Hello again. I am not sure if I need to create a new thread but here we go

I have a table of data recording details for each job an example of which is below.

[TABLE="width: 779"]
<colgroup><col width="67" style="width: 50pt;"><col width="57" style="width: 43pt;"><col width="41" style="width: 31pt;"><col width="63" style="width: 47pt;"><col width="61" style="width: 46pt;"><col width="49" span="10" style="width: 37pt;"></colgroup><tbody>[TR]
[TD="class: xl69, width: 67, bgcolor: #B4C6E7"]First Name[/TD]
[TD="class: xl69, width: 57, bgcolor: #B4C6E7"]Surname[/TD]
[TD="class: xl69, width: 41, bgcolor: #B4C6E7"]DOB[/TD]
[TD="class: xl69, width: 63, bgcolor: #B4C6E7"]Address[/TD]
[TD="class: xl69, width: 61, bgcolor: #B4C6E7"]email[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[TD="class: xl69, width: 49, bgcolor: #B4C6E7"]other[/TD]
[/TR]
[TR]
[TD="class: xl66"]bob[/TD]
[TD="class: xl66"]dylan[/TD]
[TD="class: xl67, align: right"]1-Aug[/TD]
[TD="class: xl66"]123 street[/TD]
[TD="class: xl68"]1@2.com[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[TD="class: xl66, align: right"]12345[/TD]
[/TR]
[TR]
[TD="class: xl66"]sally[/TD]
[TD="class: xl66"]taylor[/TD]
[TD="class: xl67, align: right"]1-Sep[/TD]
[TD="class: xl66"]124 street[/TD]
[TD="class: xl68"]3@2.com[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[TD="class: xl66, align: right"]54321[/TD]
[/TR]
[TR]
[TD="class: xl66"]frank[/TD]
[TD="class: xl66"]abignail[/TD]
[TD="class: xl67, align: right"]1-Oct[/TD]
[TD="class: xl66"]125 street[/TD]
[TD="class: xl68"]2@2.com[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[TD="class: xl66, align: right"]21564[/TD]
[/TR]
[TR]
[TD="class: xl66"]tim[/TD]
[TD="class: xl66"]sherman[/TD]
[TD="class: xl67, align: right"]1-Nov[/TD]
[TD="class: xl66"]126 street[/TD]
[TD="class: xl68"]5@2.com[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[TD="class: xl66, align: right"]65241[/TD]
[/TR]
[TR]
[TD="class: xl66"]paul[/TD]
[TD="class: xl66"]tims[/TD]
[TD="class: xl67"] [/TD]
[TD="class: xl66"]127 street[/TD]
[TD="class: xl68"]4@2.com[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[TD="class: xl66, align: right"]65478[/TD]
[/TR]
[TR]
[TD="class: xl66"]sam[/TD]
[TD="class: xl66"]taylor[/TD]
[TD="class: xl67, align: right"]2-Dec[/TD]
[TD="class: xl66"]128 street[/TD]
[TD="class: xl68"]6@2.com[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[TD="class: xl66, align: right"]987987[/TD]
[/TR]
</tbody>[/TABLE]

What I am trying to do is create a macro to create a new sheet for a selected job using a template.

Function 1, is to select the row of the selected Cell
Function 2, is to create a new sheet from a template sheet and name it according to the content of the selected cell
Function 3, is to copy the data from the selected row into row2 of the newly created sheet.
Function 4, check to see if there is a sheet with this name and pop up a message box and end. (there is already a way to navigate to the sheet if there is one)

The code I have created the new sheet fine. So if I select last name dylan, it creates a new sheet called dylan. I have no idea how to get the new sheet created to match a template sheet still working on that.

The problem I have is that the data copied to the new sheet is for the last row of the selected data table. it doesn't matter which name I select the new sheet has sam taylors data in row 2.

I would love some help with this as well as how to get the new sheet to be created from a template sheet

Thanks for the help it is greatly appreciated.


Sub test()


Dim lastRow As Long
Dim thisRow As Long
Dim nextRow As Long
Dim sheetCount As Long
Dim selectedCells
Dim newSheet As Worksheet


On Error Resume Next


Application.ScreenUpdating = False


lastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
selectedCells = Application.Selection.Value


For sheetCount = 1 To UBound(selectedCells, 1)
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
newSheet.Name = selectedCells


nextRow = 2
For thisRow = 2 To lastRow
If Sheets("Sheet1").Cells(thisRow, "A").Value = selectedCells(sheetCount, 1) Then
Sheets("Sheet1").Cells(thisRow, "A").EntireRow.Copy Destination:=newSheet.Cells(nextRow, "A")


End If

Next thisRow
Next sheetCount


Sheets("Sheet1").Activate
Range("A1").Select


Application.ScreenUpdating = True


End Sub

 

[JasonBing]

GOOD NEWS

I have an update. I am getting the create new from template now but still getting the wrong data

Sub test2()


Dim lastRow As Long
Dim thisRow As Long
Dim nextRow As Long
Dim sheetCount As Long
Dim selectedCells
Dim newSheet As Worksheet


On Error Resume Next


Application.ScreenUpdating = False


lastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
selectedCells = Application.Selection.Value


For sheetCount = 1 To UBound(selectedCells, 1)
Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set newSheet = Sheets(Sheets.Count)
newSheet.Name = selectedCells


nextRow = 2
For thisRow = 2 To lastRow
If Sheets("Sheet1").Cells(thisRow, "A").Value = selectedCells(sheetCount, 1) Then
Sheets("Sheet1").Cells(thisRow, "A").EntireRow.Copy Destination:=newSheet.Cells(nextRow, "A")


End If

Next thisRow
Next sheetCount


Sheets("Sheet1").Activate
Range("A1").Select


Application.ScreenUpdating = True


End Sub



This creates a new sheet with cell name and copies the template!

Still doesn't check to see if there is already one and stop code yet.

Cheers

 

[JasonBing]

Now it is pasting the right data. I just need figure out how to get it to search and stop if there is a sheet with this name with a message box!!

YAY

Sub CreateJobCard()


Dim lastRow As Long
Dim thisRow As Long
Dim nextRow As Long
Dim sheetCount As Long
Dim selectedCells
Dim newSheet As Worksheet


On Error Resume Next


Application.ScreenUpdating = False


lastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
selectedCells = Application.Selection.Value


For sheetCount = 1 To UBound(selectedCells, 1)
Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set newSheet = Sheets(Sheets.Count)
newSheet.Name = selectedCells


nextRow = 2
For thisRow = 2 To lastRow
If Sheets("Sheet1").Cells(thisRow, "A").Value = selectedCells Then

Sheets("Sheet1").Cells(thisRow, "A").EntireRow.Copy Destination:=newSheet.Cells(nextRow, "A")
nextRow = nextRow + 1

End If

Next thisRow
Next sheetCount


Sheets("Sheet1").Activate
Range("A1").Select


Application.ScreenUpdating = True


End Sub

 

[Fluff]

As this is a totally different question, you need to start a new thread.
Thanks