calculating network days, with some dates omitted from exceptions - Excel - excel

The following is a macro which collects data from data we import into certain tabs. When the macro is run it filters through the data and produces a new excel book with this new data. The person who created this is no longer with us. The macro works fine except I'm trying to add another column like the one that calculates network days called days since 1st auth less parked. Im wanting to add another which gives days since the start of the information being passed to us. Ie a column call 1st instructed less parked.
Sub Runme()
'
' Macro1 Macro
' Macro recorded 22/03/2013'
'
Sheets("CCX data SORTED").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("CCX Data Raw").Select
Range("A:C,E:G").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.AutoFilter
Range("H2").Select
Range("A1:X10000").Sort Key1:=Range("H1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H55000").End(xlUp)(2, 1).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.ClearContents
Cells.Select
Selection.Copy
Sheets("CCX data SORTED").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("CCX Data Raw").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("CCX data SORTED").Select
Columns("X:X").Select
Selection.Insert Shift:=xlToRight
Range("X2").Select
ActiveCell.FormulaR1C1 = _
"=IF(VLOOKUP(RC[-23],'SCMT weekly data'!C[-17]:C[-11],7,FALSE)>0,(VLOOKUP(RC[-23],'SCMT weekly data'!C[-17]:C[-11],7,FALSE)),"""")"
Range("X2").Select
Selection.AutoFill Destination:=Range("X2:X5000")
Range("X1").Select
ActiveCell.FormulaR1C1 = "SCMT end Date"
Columns("X:X").Select
Selection.NumberFormat = "m/d/yyyy"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCMT Weekly data").Select
Columns("Z:Z").Select
Selection.Insert Shift:=xlToRight
Range("Z1").Select
ActiveCell.FormulaR1C1 = "Days To Exclude 1"
Range("Z2").Select
ActiveCell.FormulaR1C1 = _
"=IF(COUNTA(RC[-2],RC[-1])=2,NETWORKDAYS(RC[-2],RC[-1],'Bank hols'!RC[-25]:R[56]C[-25]),0)"
Selection.AutoFill Destination:=Range("Z2:Z5000"), Type:=xlFillDefault
Columns("AD:AD").Select
Selection.Insert Shift:=xlToRight
Range("AD1").Select
ActiveCell.FormulaR1C1 = "Days To Exclude 2"
Range("AD2").Select
ActiveCell.FormulaR1C1 = _
"=IF(COUNTA(RC[-2],RC[-1])=2,NETWORKDAYS(RC[-2],RC[-1],'Bank hols'!RC[-29]:R[56]C[-29]),0)"
Selection.AutoFill Destination:=Range("AD2:AD5000")
Columns("Z:Z").Select
Selection.NumberFormat = "0"
Columns("AD:AD").Select
Selection.NumberFormat = "0"
Range("AH2").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "Days since first auth"
Range("AF2").Select
ActiveCell.FormulaR1C1 = _
"=IF(COUNTA(RC[-21],R2C34)=2,NETWORKDAYS(RC[-21],R2C34,'Bank hols'!RC[-31]:R[56]C[-31]),"""")"
Range("AG2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNUMBER(RC[-1]),SUM(RC[-1]-(RC[-3]+RC[-7])),"""")"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "Days since 1st Auth less parked"
Columns("AH:AH").Select
Selection.Insert Shift:=xlToRight
Range("AH1").Select
ActiveCell.FormulaR1C1 = "Still Parked"
Range("AH2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(ISNUMBER(RC[-10]),ISBLANK(RC[-9])),""XX"",IF(AND(ISNUMBER(RC[-6]),ISBLANK(RC[-5])),""XX"",""""))"
Selection.AutoFill Destination:=Range("AH2:AH5000")
Range("AF2:AG2").Select
Selection.AutoFill Destination:=Range("AF2:AG5000")
Range("A55000").End(xlUp)(2, 1).Select
Selection.EntireRow.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("CCX data SORTED").Select
Range("Z1").Select
ActiveCell.FormulaR1C1 = "SCMT Queue"
Range("Z2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-25],'SCMT Daily Drop'!C[-16]:C[-14],3,FALSE)"
Selection.AutoFill Destination:=Range("Z2:Z5000")
Range("AA1").Select
ActiveCell.FormulaR1C1 = "Days Since First Approved"
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,'SCMT weekly data'!C7:C34,27,FALSE)"
Selection.AutoFill Destination:=Range("AA2:AA5000")
Range("AB1").Select
ActiveCell.FormulaR1C1 = "Still Parked"
Range("AB2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,'SCMT weekly data'!C7:C34,28,FALSE)"
Selection.AutoFill Destination:=Range("AB2:AB5000")
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A55000").End(xlUp)(2, 1).Select
Selection.EntireRow.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("SCMT weekly data").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(Array("SCMT weekly data", "SCMT Daily Drop", "CCX data SORTED")).Select
Sheets("CCX data SORTED").Activate
Sheets(Array("SCMT weekly data", "SCMT Daily Drop", "CCX data SORTED")).Copy
Windows("SCMT Parked.xls").Activate
Sheets("SCMT weekly data").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("SCMT Daily Drop").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("CCX data SORTED").Select
Cells.Select
Selection.Delete Shift:=xlUp
MsgBox ("Macro Complete")
End Sub

Where do you want it? IF you want it in the z column, for example, try:
Columns("Z:Z").Select
Selection.Insert Shift:=xlToRight
Range("Z1").Select
ActiveCell.FormulaR1C1 = "New formula"
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=AA2-AB2"
Selection.AutoFill Destination:=Range("Z2:Z5000")
I don't understand the formula you need, but there's a template you can use... If you give us the formula we can put it the second last line?

Related

Extend deadline for today's dates

I use the following VBA to extend the deadline of over-due (due today) tasks in the end of the day. However, I realized that applying the script twice (I linked the script to a button, which I accidentally pressed twice) results in all task-dates (and also the tasks with no date assigned) to be repalaced by tomorrow's date or get a date (next day).
How can I avoid this unwanted behavior? It seems the selection process of the dates to be changed is distored when applying the script twice.
Sub To_Do_Add_Day_Deadline()
'
' To_Do_Add_Day_Deadline Makro
'
'
Range("C2").Select
ActiveSheet.ListObjects("Tabelle113").Range.AutoFilter Field:=3, Criteria1 _
:=xlFilterToday, Operator:=xlFilterDynamic
Range("C4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("C4").Select
ActiveCell.FormulaR1C1 = "=TODAY()+1"
Range("C4").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("E6").Select
ActiveSheet.ListObjects("Tabelle113").Range.AutoFilter Field:=3
Range("C4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E5").Select
End Sub
I replace Range("C4") with Range("C2"), because when you apply a filter, the table constraint their rows, and ever start at the next line after the header Range(""). I test this in a Table with a Range("A1:E25") with a header.
Sub To_Do_Add_Day_Deadline()
Range("C2").Select
ActiveSheet.ListObjects("Tabelle113").Range.AutoFilter Field:=3, Criteria1 _
:=xlFilterToday, Operator:=xlFilterDynamic
Range("C4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection = CDate(Left(CDate(Now) + 1, 10))
Application.CutCopyMode = False
Range("E6").Select
ActiveSheet.ListObjects("Tabelle113").Range.AutoFilter Field:=3
End Sub
Edit: I reduce the code and replace "=TODAY()+1" with CDate(Left(CDate(Now) + 1, 10))
I changed the approach and now use the following code, which works fine:
Sub On_Hold_Add_One_Day()
'
' On_Hold_Add_One_Day
'
'
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E4").Select
ActiveCell.FormulaR1C1 = "=IF([#Deadline]=TODAY(),[#Deadline]+1,[#Deadline])"
Range("E4").Select
ActiveWindow.SmallScroll Down:=-9
Range("E4").Select
ActiveWindow.SmallScroll Down:=0
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-36
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-9
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Selection.Rows.AutoFit
Range("E6").Select
End Sub

Macro blanking value when only one row in spreadsheet

I have a macro that performs some cleanup on values. It works fine unless there is only one row of data in the spreadsheet; if there is only one row, it blanks out my value instead of fixing it.
Sub UpdateNumberFormat()
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Columns("AL:AM").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.NumberFormat = "General"
Range("AL2").Select
ActiveCell.FormulaR1C1 = "'"
Range("AM2").Select
ActiveCell.FormulaR1C1 = "=CONCAT(RC[-1],RC[1])"
Range("AL2:AM" & LastRow).Select
Selection.FillDown
Range("AM2:AM" & LastRow).Select
Selection.Copy
Range("AN2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("AL:AM").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.NumberFormat = "General"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
Range("C2:C" & LastRow).Select
Selection.FillDown
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub

Excel VBA - Need to grab a variable size of rows

New to VBA - Recorded the macro below and every time I run it it always selects 309 rows. I am wanting the rows to be fluid (Example: Could be 400 rows, could be 10 depending on data.
Columns("H:H").Select
`Selection.Style = "Comma"
Range("I2").Select
Selection.EntireColumn.Insert
Range("H1").Select
Selection.Copy
Range("I1").Select
ActiveSheet.Paste
Range("I2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-3]=""C"",RC[-1]*-1,RC[-1])"
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I309")
Range("I2:I309").Select
Columns("I:I").Select
Selection.Copy
Range("I1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H4").Select
Application.CutCopyMode = False
Selection.EntireColumn.Delete
Range("L7").Select
Selection.EntireColumn.Insert
Range("K1").Select
Selection.Copy
Range("L1").Select
ActiveSheet.Paste
Range("L2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],4)"
Range("L3").Select
ActiveWindow.SmallScroll Down:=-12
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L309")
Range("L2:L309").Select
Columns("L:L").Select
Selection.Copy
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K2").Select
Application.CutCopyMode = False
Selection.EntireColumn.Delete
Range("M23").Select
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
Range("K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("C281").Select
Selection.End(xlUp).Select
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
Range("C2:D2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range("$C$2:$D$309").RemoveDuplicates Columns:=Array(1, 2), _
There's too much going on here for me to translate all of this code for you, but I believe the word you're looking for here is dynamic. In order to replace 309 with a dynamic last row number, you'll need to change:
Selection.AutoFill Destination:=Range("I2:I309")
to
Selection.AutoFill Destination:=Range("I2:I" & Cells(Rows.Count, "I").End(xlUp).Row)
and
Selection.AutoFill Destination:=Range("L2:L309")
to
Selection.AutoFill Destination:=Range("L2:L" & Cells(Rows.Count, "L").End(xlUp).Row)
etcetera, etcetera. Also like #cybernetic.nomad said, you should read that link he shared with you.

Excel VBA - vlookup for a variable number of rows within a macro

I've created a macro to organize a data set and compile into another sheet in a way that makes more sense for doing analyses. The set originally is comprised of columns for user, timestamp and 3 possible events. The user could appear on multiple rows but I wanted to look at this data set by user and have a separate column for each timestamp. The macros I've made can successfully clean, filter by event type, and separate by event type into separate worksheets (no matter how many rows of data) but I'm having trouble with compiling data into one sheet using vlookup AND accounting for a variable number of rows. I have looked at other answers to this question and tried this:
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Email Opened'!R1C1:R" & LastRow0 & "C3,2,FALSE)"
... but it keeps giving me errors.
What I have below (Vlookup_events2) works but just not for the entire variable number of rows.Please help me adjust the code for the vlookup so it will work no matter how many rows.
Here is the code below for separating data (just for reference), then the problem macro - compiling it with vlookup. I would really appreciate some help, I know there's an amazing VBA expert out there!
Sheets.Add
Sheets("Sheet1").Name = "Email Sent"
ActiveSheet.Next.Select
Selection.AutoFilter
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Range("$A$1:$D$1000000").AutoFilter Field:=3, Criteria1:= _
"=Campaign Created", Operator:=xlOr, Criteria2:="=Email Sent"
ActiveCell.Offset(0, -2).Range("A1:D2355").Select
ActiveCell.Activate
Selection.Copy
ActiveSheet.Previous.Select
Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
Range("A1").Select
ActiveSheet.Range("$A$1:$D$1000000").AutoFilter Field:=3, Criteria1:= _
"=Campaign Created", Operator:=xlOr, Criteria2:="=Email Opened"
Sheets.Add
Sheets("Sheet2").Name = "Email Opened"
ActiveSheet.Next.Select
ActiveCell.Range("A1:D1000000").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Previous.Select
Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 3).Range("A1").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets.Add
Sheets("Sheet3").Name = "Clicked Link"
ActiveSheet.Next.Select
ActiveSheet.Next.Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Range("$A$1:$D$1000000").AutoFilter Field:=3, Criteria1:= _
"=Campaign Created", Operator:=xlOr, Criteria2:="=Clicked Link"
ActiveCell.Offset(0, -2).Range("A1:D1000000").Select
ActiveCell.Activate
Selection.Copy
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 3).Columns("A:A").EntireColumn.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub
Sub Vlookup_events2()
' Vlookup_events2 Macro
ActiveSheet.Previous.Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "user"
Range("A3").Select
ActiveSheet.Next.Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "user"
Range("A3").Select
ActiveSheet.Next.Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "user"
Range("A3").Select
Sheets.Add
Sheets("Sheet4").Name = "Compiled Events"
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Next.Select
Range("A1").Select
ActiveSheet.Paste
Columns("C:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveCell.FormulaR1C1 = "Email Sent Time"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Email Opened Time"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Clicked Link Time"
Range("A1").Select
Application.Goto Reference:="R2C3"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Email Opened'!R1C1:R601C3,2,FALSE)"
Range("C3").Select
Range(Selection, Selection.End(xlUp)).Select
Columns("C:C").Select
Selection.FormulaR1C1 = "=VLOOKUP(RC[-2],'Email Opened'!R1C1:R601C3,2,FALSE)"
Columns("D:D").Select
Selection.FormulaR1C1 = "=VLOOKUP(RC[-3],'Clicked Link'!R1C1:R56C3,2,FALSE)"
Columns("C:C").Select
Selection.NumberFormat = "m/d/yyyy h:mm"
Columns("D:D").Select
Selection.NumberFormat = "m/d/yyyy h:mm"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Email Opened Time"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Clicked Link Time"
Range("C2").Select
End Sub

Excel Copy Paste Area not the Same

Hello I have this Excel Macro of generating a new sheet by copy pasting certain stuff from an existing sheet. Basically the first three paragraphs are being repeated thrice, and the final 10th paragraph is just to populate a column. However for the 7th, 8th and 9th para, its showing me
'Error 1004 copy and paster areas are not the same' whereas it is working above without any such problem.
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
Sheets("Sheet1").Move Before:=Sheets(2)
Range("A1").Select
ActiveCell.FormulaR1C1 = "Product Number"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Product Desc"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Service Type"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Service Level"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Service P/N"
Range("F1").Select
ActiveCell.FormulaR1C1 = "APAC(USD)"
Range("F2").Select
Columns("A:A").ColumnWidth = 14.27
Columns("B:B").ColumnWidth = 15.13
Columns("C:C").ColumnWidth = 13.27
Columns("D:D").ColumnWidth = 13.13
Columns("E:E").ColumnWidth = 14.33
Columns("F:F").ColumnWidth = 12.07
Sheets("1. SMARTnet ").Select
Range("B9:C20694").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Paste
Columns("B:B").ColumnWidth = 40
Sheets("1. SMARTnet ").Select
Range("D9:E20694").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("E2").Select
ActiveSheet.Paste
Range("D2").Select
Sheets("1. SMARTnet ").Select
Range("D1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D2").Select
ActiveSheet.Paste
Columns("D:D").ColumnWidth = 17.07
Range("D3").Select
ActiveSheet.Paste
Range("D2:D3").Select
Selection.AutoFill Destination:=Range("D2:D20687"), Type:=xlFillDefault
Range("D2:D20687").Select
Sheets("1. SMARTnet ").Select
Range("B9:C20694").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A20688").Select
ActiveSheet.Paste
Sheets("1. SMARTnet ").Select
Range("F9:G20694").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("E20688").Select
ActiveSheet.Paste
Range("D2").Select
Sheets("1. SMARTnet ").Select
Range("F1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D20688").Select
ActiveSheet.Paste
Range("D20689").Select
ActiveSheet.Paste
Range("D20688:D20689").Select
Selection.AutoFill Destination:=Range("D20688:D41373"), Type:=xlFillDefault
Range("D20688:D41373").Select
Sheets("1. SMARTnet ").Select
Range("B9:C20694").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A41374").Select
ActiveSheet.Paste
Sheets("1. SMARTnet ").Select
Range("H9:I20694").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("E41374").Select
ActiveSheet.Paste
Range("D2").Select
Sheets("1. SMARTnet ").Select
Range("H1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D41374").Select
ActiveSheet.Paste
Range("D41375").Select
ActiveSheet.Paste
Range("D41374:D41375").Select
Selection.AutoFill Destination:=Range("D41374:D62059"), Type:=xlFillDefault
Range("D41374:D62059").Select
Sheets("1. SMARTnet ").Select
Range("B9:C20694").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A62060").Select
ActiveSheet.Paste
Sheets("1. SMARTnet ").Select
Range("P9:P20694,U9:U20694").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("E62060").Select
ActiveSheet.Paste
Range("D2").Select
Sheets("1. SMARTnet ").Select
Range("P1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D62060").Select
ActiveSheet.Paste
Range("D62061").Select
ActiveSheet.Paste
Range("D62060:D62061").Select
Selection.AutoFill Destination:=Range("D62060:D82745"), Type:=xlFillDefault
Range("D62060:D82745").Select
Range("C2").Select
ActiveCell.FormulaR1C1 = "SMARTnet"
Selection.AutoFill Destination:=Range("C2:C82745"), Type:=xlFillDefault
Range("C2:C82745").Select
End Sub
Any hint will be appreciated :)
I think you should simplifi your code by not using "select"
for Example
instead of
Sheets("1. SMARTnet ").Select
Range("B9:C20694").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Paste
You can write as
Sheets("1. SMARTnet ").Range("B9:C20694").Copy Sheets("Sheet1").Range("a2")
Then you will be able to find the error better
This will also run faster because it saves screen updating time.

Resources