Excel crashing after changing cell colors - excel

We have a file that we use around the office. It's made by someone who is not working here anymore.
For a while, the file keeps crashing when we change any cell color.
There are some macro's in the file and I know a bit of VBA myself but I cannot find any problems.
I was hoping someone here could help me.
All the macros are called via buttons and when I remove all the code in the module then I can change the cell color.
So is the module corrupted or is there something wrong with the code, any ideas?
The code is not tidy at all, my apologies for that.
This is the code:
Sub Info()
MsgBox "Grijze cellen bevatten formules -> bij voorkeur niet wijzigen" & vbCr & vbCr & _
"Per regel wordt één ruimte ingevoerd, de kolom 'aantal' wordt alleen bij totalen meegenomen" & vbCr & vbCr & _
"Let op met standaard plakken omdat ook de voorwaardelijke opmaak (lijsten) worden gekopieerd" & vbCr & _
" Gebruik liever 'waarden plakken' als kopieren noodzakelijk is" & vbCr & vbCr & _
"Geen regels invoegen, gebruik de kopieerknoppen bovenin" & vbCr & _
"Regels in zijn geheel verwijderen (rechts klikken op het regelnummer)" & vbCr & vbCr & _
"Maximale waarde van bouwbesluit en eigen invoer wordt gehanteerd" & vbCr & vbCr & _
"Overstort: " & vbCr & _
"- Invullen niet noodzakelijk" & vbCr & _
"- Dient bij beide ruimtes te worden ingevuld" & vbCr & _
"- vb. de overstort van gang naar badkamer dient te worden ingevuld als afvoer van de gang EN toevoer in de badkamer" & vbCr & vbCr & _
"Mogelijke foutmelding over kringverwijzingen bij openen negeren" & vbCr & vbCr & _
"Standaard verdiepingshoogte controleren wanneer regel wordt ingevoegd" & vbCr & vbCr & _
"Het OVB-blad filtert automatisch op het streepje in de kolom 'Voldoet'," & vbCr & _
"wanneer je een ruimte toch in het OVB-blad wilt laten zien dient het" & vbCr & _
"streepje vervangen te worden", vbInformation, "INSTRUCTIES"
End Sub
Sub knopwoningbouw()
Application.ScreenUpdating = False
Sheets("Algemeen").Rows("3002").Copy
Rows("1").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveSheet.Calculate
Sheets("Algemeen").Rows("2").Delete
Sheets("Algemeen").Rows("1").Hidden = False
Sheets("Algemeen").Rows("10").Hidden = True
Sheets("Algemeen").Rows("11").Hidden = False
Sheets("Algemeen").Rows("38").Hidden = True
Sheets("Sjabloon").Rows("81:97").Copy
Rows("39").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = True
ActiveSheet.Calculate
Sheets("Algemeen").Columns("G:H").Hidden = True
Sheets("Algemeen").Columns("J:M").Hidden = True
Sheets("Algemeen").Columns("O").Hidden = True
Sheets("Algemeen").Columns("Y").Hidden = True
Sheets("Algemeen").Columns("AF:AI").Hidden = True
Sheets("Algemeen").Columns("AK:DE").Hidden = True
Sheets("Algemeen").Columns("F").ColumnWidth = 20
Sheets("Algemeen").Columns("N").ColumnWidth = 17
Sheets("Algemeen").Columns("Q").ColumnWidth = 8.57
Sheets("Algemeen").Columns("R").ColumnWidth = 18
Sheets("Algemeen").Columns("AD").ColumnWidth = 8.43
Sheets("Algemeen").Columns("AE").ColumnWidth = 20
Sheets("Algemeen").Columns("AJ").ColumnWidth = 8
Sheets("Algemeen").Rows("3017:3019").Delete
End Sub
Sub knoputiliteitsbouw()
Application.ScreenUpdating = False
Sheets("Algemeen").Rows("3").RowHeight = 20
Sheets("Algemeen").Rows("3000").Copy
Rows("1").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveSheet.Calculate
Sheets("Algemeen").Rows("2").Delete
Sheets("Algemeen").Rows("1").Hidden = False
Sheets("Algemeen").Rows("10").Hidden = True
Sheets("Algemeen").Rows("11:38").Hidden = False
Sheets("Sjabloon").Rows("63:79").Copy
Rows("39").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = True
ActiveSheet.Calculate
Sheets("Algemeen").Rows("3017:3019").Delete
Sheets("Algemeen").Columns("AL").Hidden = True
End Sub
Sub woningb()
Answer = MsgBox("Verdieping wordt boven de geselecteerde cel ingevoegd." & vbCr & _
"(Dus ook als dit midden in een andere verdieping is)" & vbCr & vbCr & _
"Wilt u doorgaan?", vbYesNo, "LET OP!")
If Answer = vbNo Then
MsgBox "Invoegen verdieping beëindigd", vbCritical, "Invoegen beëindigd"
Exit Sub
End If
Sheets("Sjabloon").Rows("81:97").Copy
Rows(Selection.Row).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveSheet.Calculate
End Sub
Sub utiliteitsb()
Answer = MsgBox("Verdieping wordt boven de geselecteerde cel ingevoegd." & vbCr & _
"(Dus ook als dit midden in een andere verdieping is)" & vbCr & vbCr & _
"Wilt u doorgaan?", vbYesNo, "LET OP!")
If Answer = vbNo Then
MsgBox "Invoegen verdieping beëindigd", vbCritical, "Invoegen beëindigd"
Exit Sub
End If
Sheets("Sjabloon").Rows("63:79").Copy
Rows(Selection.Row).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveSheet.Calculate
End Sub
Sub ovbutiliteitsbouw()
'
' Macro kopieert voor OVB UTILITEITSBOUW relevante informatie naar een nieuw blad
' RPR, 03/2012
Answer = MsgBox("Door deze handeling wordt het huidige blad ovb utiliteitsbouw verwijderd (indien aanwezig)." & vbCr & _
"Het blad zal overnieuw worden opgebouwd aan de hand van de gegevens" & vbCr & _
"op het blad 'Algemeen'." & vbCr & vbCr & _
"Wilt u doorgaan?", vbYesNo, "LET OP!")
If Answer = vbNo Then
MsgBox "Update van het OVB UTILITEITSBOUW-blad is beëindigd", vbCritical, "Update beëindigd"
Exit Sub
End If
'TER VOORKOMING VAN EPILEPTISCHE AANVAL
Application.ScreenUpdating = False
'OUDE BLAD VERWIJDEREN EN NIEUWE AANMAKEN
On Error GoTo Nosuchsheet
Application.DisplayAlerts = False
Sheets("OVB UTILITEITSBOUW").Select
ActiveWindow.SelectedSheets.Delete
Nosuchsheet:
Application.DisplayAlerts = True
Sheets("Data").Visible = True
Sheets("DATA").Select
Sheets.Add
ActiveWorkbook.ActiveSheet.Name = "OVB UTILITEITSBOUW"
ActiveWindow.DisplayZeros = False
'Kopieer kopregels
Sheets("Algemeen").Select
Range("A3:Q10").Select
Selection.Copy
Sheets("OVB UTILITEITSBOUW").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
'Waarschuwing linksboven
With Range("B1")
.Value = "LET OP! Aanpassingen dienen te worden gemaakt in blad 'Algemeen'. Aanpassingen gemaakt in dit blad gaan verloren bij de volgende update."
.Font.Bold = True
.Font.Color = -16711932
.Font.Size = 15
End With
'Dubbele lijn
Rows("35:35").Select
Application.CutCopyMode = False
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
' .TintAndShade = 0
.Weight = xlThick
End With
'Rijhoogten kopieren
Sheets("Algemeen").Select
Rows("38:3000").Copy
Sheets("OVB UTILITEITSBOUW").Select
Rows("35:2997").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.Clear
'Ventilatietabel per kolom
'Ruimteeigenschappen tot 'hoogte'
Sheets("Algemeen").Select
Range("A38:G3000").Select
Selection.Copy
Sheets("OVB UTILITEITSBOUW").Select
Range("A35").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
'BOUWBESLUIT
Sheets("Algemeen").Select
Range("U38:Y3000").Copy
Sheets("OVB UTILITEITSBOUW").Select
Range("H35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'AANWEZIG
Sheets("Algemeen").Select
Range("AC38:AC3000").Copy
Sheets("OVB UTILITEITSBOUW").Select
Range("M35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'VOLDOET?
Sheets("Algemeen").Select
Range("AJ38:AJ3000").Copy
Sheets("OVB UTILITEITSBOUW").Select
Range("N35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'LIJNTJES BIJWERKEN
For r = 38 To 2997
Range("Q" & r).Select
If Selection.Interior.ColorIndex = 15 Then
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
' .TintAndShade = 0
.Weight = xlMedium
End With
End If
Next r
'LEGE RIJEN VERWIJDEREN
Rows("30:34").Select
Selection.Delete Shift:=xlUp
Rows("11:29").Select
Selection.Delete Shift:=xlUp
'Afdrukbereik instellen
For x = 1 To 3000
If Range("A" & x).Interior.ColorIndex = 15 Then
Laatste = x
End If
Next
PA = "$A$3:$N$" & Laatste
With ActiveSheet.PageSetup
.PrintArea = PA
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 999
End With
ActiveWindow.View = xlPageBreakPreview
'TERUG NAAR BOVEN ETC
Sheets("Algemeen").Select
Range("A20").Select
Sheets("OVB UTILITEITSBOUW").Select
Sheets("Data").Visible = False
Range("A1").Select
Application.CutCopyMode = False
'AUTOFILTER
Columns("N").Select
Selection.AutoFilter
ActiveSheet.Range("N1:N3000").AutoFilter Field:=1, Criteria1:="<>-"
'BORDER
Sheets("OVB UTILITEITSBOUW").Range("A3:N9").Select
Selection.BorderAround Weight:=xlMedium
End Sub
Sub ovbwoningbouw()
'
' Macro kopieert voor OVB WONINGBOUW relevante informatie naar een nieuw blad
' RPR, 03/2012
Answer = MsgBox("Door deze handeling wordt het huidige blad ovb woningbouw verwijderd (indien aanwezig)." & vbCr & _
"Het blad zal overnieuw worden opgebouwd aan de hand van de gegevens" & vbCr & _
"op het blad 'Algemeen'." & vbCr & vbCr & _
"Wilt u doorgaan?", vbYesNo, "LET OP!")
If Answer = vbNo Then
MsgBox "Update van het OVB UTILITEITSBOUW-blad is beëindigd", vbCritical, "Update beëindigd"
Exit Sub
End If
'TER VOORKOMING VAN EPILEPTISCHE AANVAL
Application.ScreenUpdating = False
'OUDE BLAD VERWIJDEREN EN NIEUWE AANMAKEN
On Error GoTo Nosuchsheet
Application.DisplayAlerts = False
Sheets("OVB WONINGBOUW").Select
ActiveWindow.SelectedSheets.Delete
Nosuchsheet:
Application.DisplayAlerts = True
Sheets("Data").Visible = True
Sheets("DATA").Select
Sheets.Add
ActiveWorkbook.ActiveSheet.Name = "OVB WONINGBOUW"
ActiveWindow.DisplayZeros = False
'Kopieer kopregels
Sheets("Algemeen").Select
Range("A3:Q11").Select
Selection.Copy
Sheets("OVB WONINGBOUW").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Range("A3:Q11").Select
Application.CutCopyMode = False
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
' .TintAndShade = 0
.Weight = xlThick
End With
'Waarschuwing linksboven
With Range("B1")
.Value = "LET OP! Aanpassingen dienen te worden gemaakt in blad 'Algemeen'. Aanpassingen gemaakt in dit blad gaan verloren bij de volgende update."
.Font.Bold = True
.Font.Color = -16711932
.Font.Size = 15
End With
'Dubbele lijn
Rows("35:35").Select
Application.CutCopyMode = False
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
' .TintAndShade = 0
.Weight = xlThick
End With
'Rijhoogten kopieren
Sheets("Algemeen").Select
Rows("38:3000").Copy
Sheets("OVB WONINGBOUW").Select
Rows("35:2997").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.Clear
'Ventilatietabel per kolom
'Ruimteeigenschappen tot 'oppervlakte'
Sheets("Algemeen").Select
Range("A38:F3000").Select
Selection.Copy
Sheets("OVB WONINGBOUW").Select
Range("A35").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
'OPPERVLAKTE
Sheets("Algemeen").Select
Range("N38:N3000").Copy
Sheets("OVB WONINGBOUW").Select
Range("G35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'CAPACITEIT ROOSTER
Sheets("Algemeen").Select
Range("R38:R3000").Copy
Sheets("OVB WONINGBOUW").Select
Range("H35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'BOUWBESLUIT (1/2)
Sheets("Algemeen").Select
Range("U38:X3000").Copy
Sheets("OVB WONINGBOUW").Select
Range("I35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'BOUWBESLUIT (2/2)
Sheets("Algemeen").Select
Range("Z38:Z3000").Copy
Sheets("OVB WONINGBOUW").Select
Range("M35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'AANWEZIG
Sheets("Algemeen").Select
Range("AC38:AE3000").Copy
Sheets("OVB WONINGBOUW").Select
Range("N35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'VOLDOET?
Sheets("Algemeen").Select
Range("AJ38:AJ3000").Copy
Sheets("OVB WONINGBOUW").Select
Range("Q35").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'LIJNTJES BIJWERKEN
For r = 38 To 2997
Range("P" & r).Select
If Selection.Interior.ColorIndex = 15 Then
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
' .TintAndShade = 0
.Weight = xlMedium
End With
End If
Next r
'LEGE RIJEN VERWIJDEREN
Rows("30:34").Select
Selection.Delete Shift:=xlUp
Rows("11:29").Select
Selection.Delete Shift:=xlUp
'Afdrukbereik instellen
For x = 1 To 3000
If Range("A" & x).Interior.ColorIndex = 15 Then
Laatste = x
End If
Next
PA = "$A$3:$Q$" & Laatste
With ActiveSheet.PageSetup
.PrintArea = PA
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 999
End With
ActiveWindow.View = xlPageBreakPreview
'TERUG NAAR BOVEN ETC
Sheets("Algemeen").Select
Range("A20").Select
Sheets("OVB WONINGBOUW").Select
Sheets("Data").Visible = False
Range("A1").Select
Application.CutCopyMode = False
Sheets("OVB WONINGBOUW").Rows("11").Hidden = False
'AUTOFILTER
Columns("Q").Select
Selection.AutoFilter
ActiveSheet.Range("Q1:Q3000").AutoFilter Field:=1, Criteria1:="<>-"
'BORDER
Sheets("OVB WONINGBOUW").Range("A3:N9").Select
Selection.BorderAround Weight:=xlMedium
'SAMENGEVOEGDE CELLEN SPLITSEN
Sheets("OVB WONINGBOUW").Range("D4:M9").Select
Selection.UnMerge
'FILTER NATUURLIJK
Dim cell As Range
For Each cell In Sheets("Algemeen").Range("R10")
If cell.Value = "nee" Then
Sheets("OVB WONINGBOUW").Columns("H").Select
Selection.EntireColumn.Hidden = True
Sheets("OVB WONINGBOUW").Columns("P").ColumnWidth = 0.1
End If
Next cell
End Sub
Sub printbereik()
Application.ScreenUpdating = False
For x = 1 To 3000
If Range("A" & x).Interior.ColorIndex = 15 Then
Laatste = x
End If
Next
PA = "$A$3:$AK$" & Laatste
With ActiveSheet.PageSetup
.PrintArea = PA
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 999
End With
ActiveWindow.View = xlPageBreakPreview
End Sub
Sub copyUp()
Rows(Selection.Row).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub
Sub copyDown()
Rows(Selection.Row).Select
Selection.Copy
Selection.Insert Shift:=xlUp
Application.CutCopyMode = False
End Sub

Related

Why can I not reference a sheet name all of a sudden after over a year of running this Macro?

'-2147319767 (80028029)':
Been using this code for over a year now. Suddenly today, it gets the above run-time error when calling out certain sheet names or calling out Activesheet.
Absolutely no idea why it decided not to function today.
'''
Sheets("WIP Shortage").Select
Range("A:CB").Select
Selection.Delete Shift:=xlUp
Range("CC1").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("CC1").Select
Selection.NumberFormat = "yyyy m-d;#"
ChDir "S:\Skim Kits\WIP Shortage Report"
Workbooks.Open Filename:= _
"S:\Skim Kits\WIP Shortage Report\" & Range("CC1").Text & " GEUD_WIP_Job_Shortage_Shop_Fl_ELO.xlsx"
Range("CC1").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("CC1").Select
Selection.NumberFormat = "yyyy m-d;#"
Range("CC2").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("CC2").Select
Selection.NumberFormat = "yyyy-m-d;#"
Cells.Select
Selection.Copy
Windows("Availability-Shortages" & Range("CC2").Text).Activate
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("CD2").Select
ActiveCell.FormulaR1C1 = "=ISOWEEKNUM(RC[-76])"
Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown))
Windows(Range("CC1").Text & " GEUD_WIP_Job_Shortage_Shop_Fl_ELO.xlsx").Activate
ActiveWindow.Close
' Paste Thiswk Lastwk formula as values on QMI Targets
Application.Calculation = xlManual
Sheets("WIP Shortage").Select
Range("CE2").Select
ActiveCell.Formula = "=CD2+1"
Application.Calculation = xlAutomatic
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.Calculation = xlManual
Sheets("QMI TARGETS").Select
Range("AL2").Select
ActiveCell.Formula = "=SUMIFS('WIP Shortage'!L:L,'WIP Shortage'!K:K,A2,'WIP Shortage'!E:E,""OP"",'WIP Shortage'!CD:CD,ISOWEEKNUM(NOW()))"
Selection.Copy
Range("AL2:AL300").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.Calculation = xlAutomatic
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.Calculation = xlManual
Range("AM2").Select
ActiveCell.Formula = "=SUMIFS('WIP Shortage'!L:L,'WIP Shortage'!K:K,A2,'WIP Shortage'!E:E,""OP"",'WIP Shortage'!CE:CE,ISOWEEKNUM(NOW()))"
Selection.Copy
Range("AM2:AM300").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.Calculation = xlAutomatic
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'''
This is an excerpt from the entire code, but that first line is the first of 4 places it faults out. If I debug and manual select the sheet and move down the to the next line and run, it goes fine until I try to call out active sheet on line 23.
This is the code that precedes it and it runs fine. You'll notice it calls out my "today" sheet just fine and even renames it.
'''
Sheets("Today").Select
If Range("C5") = "Fri" Then
Sheets("Fri").Select
If Range("C5") = "Fri" Then
Sheets("Fri").Select
ActiveWindow.SelectedSheets.Delete
End If
End If
'''

Error while porting excel information to word - Compile error: User-defined type not defined,

I'm getting a compile error when I try to run this code:
(Only a section of it is shown here because only one bit is highlighted in the debugger)
The bolded bit is the part which is giving me problems.
The references I have active are:
Visual Basic for Applications
Microsoft Excel 16.0 Object Library
Microsoft ActiveX Data Objects 6.1 Library
OLE Automation
Microsoft Office 16.0 Object Library
We're running in Word and Excel 2016.
Any help would be greatly appreciated.
'This will delete any rows that have findings that took place prior to the date that was previously entered.
For CellNum = TotalRowNum To 1 Step -1
If Cells(CellNum, 10) < backtolong Then Rows(CellNum).Delete
Next
CurrentRowNum = Cells(Rows.Count, 2).End(xlUp).Row
'This sorts the findings remaining based on alphabetical order, to make the copy over to word easier as A is first... etc.
Range("A1:J" & CurrentRowNum).Sort key1:=Range("I1:I" & CurrentRowNum), order1:=xlAscending, Header:=xlNo
Dim lastrow As Long
lastrow = ThisWorkbook.Sheets("Pre-Transfer Table").Range("A1", ThisWorkbook.Sheets("Pre-Transfer Table").Range("A1").End(xlDown)).Rows.Count
'Designates the file that the data will be transferred to.
Dim stWordDocument As String
stWordDocument = InputBox("Please enter the name of the word file you have created for this report (Include '.doc').")
**Dim wdApp As Word.Application**
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
Dim i As Long
Dim j As Long
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim vaData As Variant
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Pre-Transfer Table")
'Creates a 2D array populated by all of the finding critera
ReDim vaData(1 To lastrow, 1 To 8)
With wsSheet
vaData = .Range("A1:H" & lastrow)
End With
Set wdApp = New Word.Application
'Opens the word document by accessing the same folder the workbook is stored in
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)
'Populates the tables with the corresponding criteria
k = 4
For i = 1 To lastrow
j = 0
For Each wdCell In wdDoc.Tables(k).Columns(2).Cells
j = j + 1
wdCell.Range.Text = vaData(i, j)
Next wdCell
k = k + 1
Next i
'Deletes the sheet used for sorting, as the code cannot run again unless this sheet is removed or the name of it is changed.
ThisWorkbook.Sheets("Pre-Transfer Table").Delete
With wdDoc
.Save
.Close
End With
wdApp.Quit
'Frees up memory by clearing these variables.
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "Your report has been generated.", vbInformation
End Sub
This section is giving me the error:
Sheets("Other Findings").Select
**Range("Table2[ASSIGNED" & Chr(10) & "TO]").Select**
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("E" & FindingRowNum + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
:=False, Transpose:=False
In the code section
'Creates the sheet where the resorting of data is done. All of the relevant columns are copied over to this table.
Sheets.Add
ActiveSheet.Name = "Pre-Transfer Table"
Sheets("Risk Ranked Findings").Select
Range("Table1[DETAILS]").Select
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Risk Ranked Findings").Select
Range("Table1[LOCATION]").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Risk Ranked Findings").Select
Application.CutCopyMode = False
Range("Table1[TYPE]").Select
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Risk Ranked Findings").Select
Range("Table1[RECOMMENDED" & Chr(10) & "ACTION]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Risk Ranked Findings").Select
Range("Table1[DUE DATE]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = True
Selection.NumberFormat = "m/d/yyyy"
Sheets("Risk Ranked Findings").Select
Range("Table1[ASSIGNED" & Chr(10) & "TO]").Select
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Risk Ranked Findings").Select
Range("Table1[RISK]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("I1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Risk Ranked Findings").Select
Range("Table1[FINDING" & Chr(10) & "DATE]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("J1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Risk Ranked Findings").Select
Range("S2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("M1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
FindingRowNum = Range("M1")
'This area is where the "Other Findings" are sorted and transferred. There is probably some redundancy here so if anything is to be cleaned up it is
'most likely this.
Dim OtherRowNum As Long
Dim TotalRowNum As Long
Dim CurrentRowNum As Long
Sheets("Other Findings").Select
Range("O2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
OtherRowNum = Range("M2")
TotalRowNum = OtherRowNum + FindingRowNum
Sheets("Other Findings").Select
Range("Table2[DETAILS]").Select
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("A" & FindingRowNum + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Other Findings").Select
Range("Table2[LOCATION]").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("B" & FindingRowNum + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Other Findings").Select
Application.CutCopyMode = False
Range("Table2[RECOMMENDED" & Chr(10) & "Action]").Select
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("C" & FindingRowNum + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Other Findings").Select
Range("Table2[DUE DATE]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("D" & FindingRowNum + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = True
Selection.NumberFormat = "m/d/yyyy"
Sheets("Other Findings").Select
Range("Table2[ASSIGNED" & Chr(10) & "TO]").Select
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("E" & FindingRowNum + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Other Findings").Select
Range("Table2[TYPE]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("I" & FindingRowNum + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Other Findings").Select
Range("Table2[FINDING" & Chr(10) & "DATE]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pre-Transfer Table").Select
Range("J" & FindingRowNum + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Macro giving out error "Run-time error 1004: Method 'Range' of object'_Global' failed

Sub Load()
'
' Load Evaluation Macro
'
'
Dim zelda As Integer
zelda = Lookup()
Sheets("RawData").Select
Range("A" & zelda).Select (highlighted row in yellow)
Selection.Copy
Sheets("Evaluation Form").Select
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RawData").Select
Range("C" & zelda & " :G" & zelda).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Evaluation Form").Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RawData").Select
Range("J" & zelda & " :U" & zelda).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Evaluation Form").Select
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("RawData").Select
Range("V" & zelda & " :X" & zelda).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Evaluation Form").Select
Range("C26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("RawData").Select
Range("X" & zelda & " :Y" & zelda).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Evaluation Form").Select
Range("C33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'--------------------Load Comments------------------------------------------
Sheets("RawData").Select
Range("AA" & zelda & " :AL" & zelda).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Evaluation Form").Select
Range("E9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("RawData").Select
Range("AM" & zelda & " :AO" & zelda).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Evaluation Form").Select
Range("E19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("RawData").Select
Range("AP" & zelda & " :AQ" & zelda).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Evaluation Form").Select
Range("E24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'----------------------------------------------------------------------------
Range("E1").Select
End Sub
Function LookUp() As Integer
Dim NameAgent As String
Dim EvalID As Integer
Dim nrow As Long
Dim ncol As Long
Dim i As Long
' Look Up Values ---------------------
Sheets("Evaluation Form").Select
NameAgent = Range("D1").Value
EvalID = Range("D6").Value
'------------------------------------
Sheets("RawData").Select
nrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To nrow
If NameAgent = Cells(i, 1).Value Then
If Cells(i, 4).Value = EvalID Then
LookUp = i
End If
Else
End If
Next i
End Function
I have used this same macro in numerous workbooks and specifically this one is not running correctly.
Any help will be greatly appreciated.

Create a new workbook copying some data with macro

In my worksheet, containing over 2k Rows, I need to create a macro that would automatically open another file, and then would copy some of the data from the first worksheet in the selected row to specific cell in the newly created/opened file
I've tried the following code, but it seems to stuck at the first copying action (TECHNICAL SHEET-2020v2.xlsm is the newly created file, and Suivi Nouveautés 2020.xlsx is the actual worksheet in which I need to make the macro, and in which are the data I need to copy
Sub CREERTS()
'
' CREERTS Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+T
'
Dim RowNo As Long
Workbooks.Open Filename:= _
"Myserveradress/filename.xlsm"
ActiveWindow.Visible = False
Windows("TECHNICAL SHEET-2020v2.xlsm").Visible = True
Sheets("SPECIFICATION").Select
ActiveWindow.SmallScroll Down:=-60
Range("C12:J12").Select
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 12
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("J" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("B6:B7").Paste
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("Q" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("F8:H11").Paste
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("O" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("B8:C11").Paste
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("F" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("A13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("S" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("T" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E37").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("U" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E38").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsx").Activate
Range("AF" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Did you declare the value of RowNo?
You can optimize your code using Application.ScreenUpdating = False and Application.Calculation = xlCalculationManual in the beginning and Application.ScreenUpdating = True and Application.Calculation = xlCalculationAutomatic in the end of code.
Also you can delete all those ActiveWindow.ScrollCollumn statements. They are useless.

I've solved almost all of my issue.
The macro (code below) is working perfeclty, though taking quite some time, due to the amount of processing I guess
However, the only way to perform the macro completely is to do it from VBA directly.
If I use the shortcut Ctrl+Shift+T that I've specified, the maccro stop after opening the file, there is no data copied, no saving file...
Any idea of why?
Sub CREERTS()
'
' CREERTS Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+T
'
Dim RowNo As Long
RowNo = Selection.Row '<- Here you get the row number you have select
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Workbooks.Open FileName:= _
"\\MYSERVERADRESS\filename.xlsm"
ActiveWindow.Visible = False
Windows("TECHNICAL SHEET-2020v2.xlsm").Visible = True
Sheets("SPECIFICATION").Select
Range("B6:B7").Select
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("J" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("B6:B7").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("K" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E6").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("R" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("F8:H11").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("P" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("B8:C11").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("Y" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("J5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("Z" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("J6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("AB" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("J9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("AE" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("J10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("F" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("A13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("G" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("A16").PasteSpecial xlPasteAll
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("T" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("U" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E37").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("V" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E38").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Suivi Nouveautés 2020.xlsm").Activate
Range("AH" & RowNo).Copy
Windows("TECHNICAL SHEET-2020v2.xlsm").Activate
Range("E40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J1") = Date
Dim FilePath As String
Dim FileName As String
FilePath = "MyfolderIwanttosavethefileto"
FileName = "TS-DEV" & "-" & Range("A13") & "-" & Range("B6") & "-" & Format(Now(), "YYYY-MM-DD")
'It saves .PDF file at your Descrop with the name of the worksheet
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=FilePath & FileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Trying to copy and paste some variable data

i'm working on a existing excel file with lots of macros and want to copy and paste variable data from 5 different sheets to 5 other sheets without copying blank cells. this is what i made so far and gives me Runtime error 1004:
Sub Macro1()
Sheets("Hulp_IO").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("IO").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("Hulp_Modbus_PMSX_Lees_Tags").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Modbus_Lees_Tags_PMSX").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Hulp_Modbus_PMSX_Schrijf_Tags").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Modbus_Schrijf_Tags_PMSX").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Hulp_Modbus_Pakscan_Lees_Tags").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Modbus_Lees_Tags_PackScan").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Hulp_Modbus_Pakscan_Schrijf_Tag").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Modbus_Schrijf_Tags_PackScan").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Start").Select
End Sub

Here is your code largely reviewed, because the .Select command is really ressource-greedy and now it is far more readable!
I don't know on which line you had the error with your code but it is an important information, so add it even if this solve your problem! ;)
Here is the code :
Sub Nito_Nascimento()
Dim WsFrom As Worksheet, _
WsTo As Worksheet
Set WsFrom = Sheets("Hulp_IO")
Set WsTo = Sheets("IO")
WsFrom.Range("A1", WsFrom.Range("A" & WsFrom.Rows.Count).End(xlUp)).Copy
WsTo.Range("B2").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
Set WsFrom = Sheets("Hulp_Modbus_PMSX_Lees_Tags")
Set WsTo = Sheets("Modbus_Lees_Tags_PMSX")
Application.CutCopyMode = False
WsFrom.Range("A1", WsFrom.Range("A" & WsFrom.Rows.Count).End(xlUp)).Copy
WsTo.Range("A2").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
Set WsFrom = Sheets("Hulp_Modbus_PMSX_Schrijf_Tags")
Set WsTo = Sheets("Modbus_Schrijf_Tags_PMSX")
Application.CutCopyMode = False
WsFrom.Range("A1", WsFrom.Range("A" & WsFrom.Rows.Count).End(xlUp)).Copy
WsTo.Range("A2").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
Set WsFrom = Sheets("Hulp_Modbus_Pakscan_Lees_Tags")
Set WsTo = Sheets("Modbus_Lees_Tags_PackScan")
Application.CutCopyMode = False
WsFrom.Range("A1", WsFrom.Range("A" & WsFrom.Rows.Count).End(xlUp)).Copy
WsTo.Range("A2").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
Set WsFrom = Sheets("Hulp_Modbus_Pakscan_Schrijf_Tag")
Set WsTo = Sheets("Modbus_Schrijf_Tags_PackScan")
Application.CutCopyMode = False
WsFrom.Range("A1", WsFrom.Range("A" & WsFrom.Rows.Count).End(xlUp)).Copy
WsTo.Range("A2").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
Application.CutCopyMode = False
Sheets("Start").Activate
Set WsFrom = Nothing
Set WsTo = Nothing
End Sub

Resources