Please help to change code?

[Andries]

Hi there

How can I change this code so that it would not keep on going to Sheets("DAY 2"). but rather look at the first or next available blank sheet.


Sheets("POPULATE SEATS").Select
Cells.Select
Selection.Copy
Sheets("DAY 2").Select
Cells.Select
ActiveSheet.Paste

 

[Misca]

This one adds a new sheet + copies the sheet "POPULATE SEATS" every time you run the macro:

Sub AddSheet()
Dim WS As Worksheet
Set WS = Sheets.Add 'Adds a new worksheet
With WS
    .Name = "Day " & Worksheets.Count  'Names the new worksheet
    Sheets("POPULATE SEATS").Cells.Copy .Cells(1, 1)    'Copies the everything from "POPULATE SEATS"
End With
End Sub

 

[Weaver]

Hi there

How can I change this code so that it would not keep on going to Sheets("DAY 2"). but rather look at the first or next available blank sheet.


Sheets("POPULATE SEATS").Select
Cells.Select
Selection.Copy
Sheets("DAY 2").Select
Cells.Select
ActiveSheet.Paste

You could maybe paste the data to a new sheet

Sub test()
    Dim fs, ts
    Application.ScreenUpdating = False
    Set fs = Sheets("POPULATE SEATS")
    Set ts = Sheets.Add(after:=fs)
    fs.Cells.Copy ts.Cells
End Sub

 

[Andries]

Hi Misca

Thanks for your help. I also need to insert these 2 ranges down below in the code you gave me.

Sheets("data2").Range("A2:S2")
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("data2").Select
Range("DT3:EG3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

 

[Andries]

Hi
I also need to insert these 2 ranges down below in the code at the bottom. I forgot to ask it in my first posting.


Sheets("data2").Range("A2:S2")
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("data2").Select
Range("DT3:EG3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy[/QUOTE]

Sub AddSheet()
Dim WS As Worksheet
Set WS = Sheets.Add 'Adds a new worksheet
With WS
.Name = "Day " & Worksheets.Count 'Names the new worksheet
Sheets("POPULATE SEATS").Cells.Copy .Cells(1, 1) 'Copies the everything from "POPULATE SEATS"
End With
End Sub

 

[Misca]

Where do you want to paste the two additional ranges? Starting from the first empty cell in Columns A & DT after all the data on the new sheet?

And what happens if the first empty cells are on different rows? Should the code copy them to the same row anyway? And is there supposed to be same number of rows in both ranges?

 

[Andries]

Hi

Sorry I left it out.

Sheets("data2").Range("A2:S2") this must be copied to the new sheet that was created and paste in .Range("DA:DS")

and

Sheets("data2").Range("DT3:EG3") this must also be copied to the new sheet that was created and paste in .Range("DT:EG")

And what happens if the first empty cells are on different rows?
the data always starts in the same row and cell

Should the code copy them to the same row anyway?
Yes please

And is there supposed to be same number of rows in both ranges?
the number of rows are always variable

 

[Misca]

Try this. It should be quite easy to modify if it doesn't do exactly what you're after:

Sub AddSheet()

Dim WS As Worksheet
Dim R As Long
Dim i As Integer

Set WS = Sheets.Add 'Adds a new worksheet


With WS
    .Name = "Day " & Worksheets.Count  'Names the new worksheet
    Sheets("POPULATE SEATS").Cells.Copy .Cells(1, 1)    'Copies the everything from "POPULATE SEATS"

    For i = 1 To 2  'Copies the additional ranges from Data2:
        R = Sheets("Data2").Range(Choose(i, "A", "DT") & .Rows.Count).End(xlUp).Row 'The rows to copy (from the bottom up)
        Sheets("Data2").Range(Choose(i, "A2:S", "DT3:EG") & R).Copy .Range(Choose(i, "DA1", "DT1"))
    Next i

End With

End Sub