Marcro for copying rows below a table / database

[Matt90]

Hi All,

I am new here, but have read a lot of topics about creating macros.

I have created a macro for copying a selection to multiple worksheets (10). The macro is working, but I receive every time the following message from Excel:

"Microsoft Excel found a row of data immediately above your table or database. If the row contains column labels, you should include it in your selection so that the filter command will work properly. Do you want to include the row in your selection? Yes / No / Cancel"

I have this message for every worksheet. I have to select 10 times "yes".

I chooce always for Yes. I am happy with the result of my Macro, but I don't want to have this message every time.

So my question is, what do I have to add to my macro, so I will nog have this message any more?

My macro is a combine macro of different working macros:
- Filter the data from the mastersheet "RC All" and copy each group to a new excelsheet. The name of the excelsheet will be equal to the datagroup
- Insert 10 rows on the created worksheets, so not the mastersheet "Rc All" and helpsheet "hulpblad"
- Copy a selection from the "hulpblad" on the created 10 rows on the new worksheets.
- Sorting the data on each worksheet and
- Calculate the totals of all EUR amounts on each worksheet
- Copy a selection from the "hulpblad" to the end of each created worksheet

this is my Macro:
Sub CopyPast()


Dim c As Range
Dim rng As Range
Dim LR As Long

LR = Cells(Rows.Count, "J").End(xlUp).Row
Set rng = Range("A11:M" & LR)

Range("M11:M" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("N11"), Unique:=True

For Each c In Range([N12], Cells(Rows.Count, "N").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=13, Criteria1:=c.Value
.Range("A1:M999").Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
ActiveSheet.Paste
End With

Next c


Sheets("RC All").Select
ActiveSheet.Range("$A$1:$M$999").AutoFilter Field:=13
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

For Each sht In ThisWorkbook.Worksheets
sht.Cells.EntireColumn.AutoFit

Next sht


Dim rs As Worksheet

For Each rs In Sheets
If rs.Name <> "RC All" And rs.Name <> "hulpblad" Then
rs.Range("a1:a10").EntireRow.Insert

End If
Next rs


Dim r As Range
Set r = Sheets(2).Range("41:49")
For N = 3 To Sheets.Count
r.Copy Sheets(N).Range("1:10")
Next N


Dim Lastrw As Integer
For N = 3 To Sheets.Count
Lastrw = Worksheets(N).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(N).Sort.SortFields.Clear
Worksheets(N).Sort.SortFields.Add Key:=Range("I11:I" & Lastrw), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets(N).Sort
.SetRange Range("A11:M" & Lastrw)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


Next N


For N = 3 To Sheets.Count
Worksheets(N).Activate
Selection.subtotal GroupBy:=9, Function:=xlSum, TotalList:=Array(10), Replace:=True, PageBreaks:=False, SummaryBelowData:=True


Next N


Dim Lastln As Long
For N = 3 To Sheets.Count
With Sheets(N)
Lastln = .Range("L" & .Rows.Count).End(xlUp).Row
.Range("L" & Lastln + 5).Formula = "=Sum(L2:L" & Lastln & ")"


End With


Next N


Dim copy_from As Range
Dim copy_to As Range

Set copy_from = Worksheets(2).Range("A31:L38")
For N = 3 To Sheets.Count
Set copy_to = Worksheets(N).Range("A" & Rows.Count).End(xlUp).Offset(8, 0)

copy_from.Copy Destination:=copy_to
Application.CutCopyMode = False

Next N




End Sub


Thank you for your help.

Gr,
Matthijs

 

[gallen]

Hello, if as you say, you are happy other than the messages then you can use this:

Application.DisplayAlerts = False

Just ensure you do the reverse at the end of your code

 

[Matt90]

Thank you. Just so easy. I have tried that before, but it didn't work. I thought it wasn't working because of the code, but I have accidentally deleted some important formulas in my sheets.