can any one find any error? For some reason when i add last2 it gives na object defined error.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim src As Workbook
' Abrir EXCEL
Set src = Workbooks.Open
("U:\Mecânica\Produção\Manutenção_teste\TOA\manTOA.xlsm", True, False)
WS_Count = src.Worksheets.Count
For o = 1 To WS_Count
src.Worksheets(o).Unprotect password:="projmanutencao"
Next o
last = src.Worksheets("Manutencao").Range("A65536").End(xlUp).Row
folha = manutencaoexp.Label27.Caption
last2 = src.Worksheets("saidas").Range("A65536").End(x1Up).Row
' Escrever Registos
If manutencaoexp.ComboBox4 = "" Then
MsgBox "Introduzir todos os dados"
GoTo fim
Else
src.Worksheets("Manutencao").Cells(last + 1, 1) = Now() 'data
src.Worksheets("Manutencao").Cells(last + 1, 2) = manutencaoexp.Label28.Caption 'nº equipamento
src.Worksheets("Manutencao").Cells(last + 1, 3) = manutencaoexp.ComboBox5 'avaria
src.Worksheets("Manutencao").Cells(last + 1, 4) = manutencaoexp.ComboBox4 'serviços
src.Worksheets("Manutencao").Cells(last + 1, 5) = manutencaoexp.ComboBox7 'produtos
src.Worksheets("Manutencao").Cells(last + 1, 6) = Application.ThisWorkbook.Worksheets(folha).Cells(Monitorform.ComboBox1.ListIndex + 2, 32).Text 'duração
src.Worksheets("Manutencao").Cells(last + 1, 7) = manutencaoexp.TextBox2 'operario
src.Worksheets("Manutencao").Cells(last + 1, 8) = manutencaoexp.ComboBox6 'tipo de manutenção
src.Worksheets("Manutencao").Cells(last + 1, 9) = manutencaoexp.TextBox3 'quantidade
src.Worksheets("saidas").Cells(last2 + 1, 1) = manutencaoexp.ComboBox7 'código/produtos
'manutencaoexp.Hide
manutencaoexp.ComboBox7 = ""
manutencaoexp.TextBox3 = ""
MsgBox "Dados Introduzidos com sucesso"
End If
For o = 1 To WS_Count
src.Worksheets(o).Protect password:="projmanutencao"
Next o
Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
src.Save
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
' CLOSE THE SOURCE FILE.
src.Close True ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
fim:
End Sub
My problem is that i want to run
src.Worksheets("saidas").Cells(last2 + 1, 1) = manutencaoexp.ComboBox7
but i get na error on
last2 = src.Worksheets("saidas").Range("A65536").End(x1Up).Row
Other than that everything is running fine.
If there's any other way around to solve this error , maybe adding another button or something else.
last2 = src.Worksheets("saidas").Range("A65536").End(x1Up).Row
If you look VERY carefully at this line, you'll notice that you actually have the number 1 instead of the letter L in End(x1Up)
How that happened, I have no idea. So change the line to:
last2 = src.Worksheets("saidas").Range("A65536").End(xlUp).Row
Related
so i started writting a code that would write from Workbook1 UserForm to WorkBook2 sheet. For some unknown reason it's not copying the data .
Private Sub CommandButton1_Click()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Dim src As Workbook
' Open EXCEL
Set src = Workbooks.Open("U:\Mecânica\Produção\63177 - Qualidade\Rejeição Interna\Dados\Gaspar\Projeto Manutenção.xlsm", True, False)
WS_Count = src.Worksheets.Count
For o = 1 To WS_Count
src.Worksheets(o).Unprotect password:="projmanutencao"
Next o
last = src.Worksheets(Manutencao).Range("A65536").End(xlUp).Row
' Write regists
src.Worksheets(Manutencao).Cells(last + 1, 1) = Now() 'data
src.Worksheets(Manutencao).Cells(last + 1, 2) = manutencaoexp.ComboBox3 'nº equipamento
src.Worksheets(Manutencao).Cells(last + 1, 3) = manutencaoexp.ComboBox5 'avaria
src.Worksheets(Manutencao).Cells(last + 1, 4) = manutencaoexp.ComboBox4 'serviços
' src.Worksheets(Manutencao).Cells(last + 1, 5) = Velocidade 'produtos
' src.Worksheets(Manutencao).Cells(last + 1, 6) = Qualidade 'duração
' src.Worksheets(Manutencao).Cells(last + 1, 7) = Data 'operario
src.Worksheets(Manutencao).Cells(last + 1, 8) = manutencaoexp.ComboBox6 'tipo de manutenção
For o = 1 To WS_Count
src.Worksheets(o).Protect password:="projmanutencao"
Next o
Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
src.Save
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
' CLOSE THE SOURCE FILE.
src.Close True ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
If someone can help fix this piece of code , or maybe have a code that copies from a diferente workbook userform . I'm getting a subscript out of range error in
last = src.Worksheets(Manutenção).Range("A65536").End(x1Up).Row
Assuming 'Manutencao' is the worksheet name, then change this line to:
last = src.Worksheets("Manutencao").Range("A65536").End(xlUp).Row
Note the "" around the worksheet name. You'll have to change this wherever you reference this worksheet.
EDIT: Your code could be rewritten like this, to be a little clearer;
Private Sub CommandButton1_Click()
Dim src As Workbook
Dim last As Long
On Error GoTo ErrHandler
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set src = Workbooks.Open("U:\Mecânica\Produção\63177 - Qualidade\Rejeição Interna\Dados\Gaspar\Projeto Manutenção.xlsm", True, False)
With src.Worksheets("Manutencao")
.Unprotect Password:="projmanutencao"
last = .Cells(Rows.Count, "A").End(xlUp).Row
.Cells(last + 1, 1) = Now() 'data
.Cells(last + 1, 2) = manutencaoexp.ComboBox3 'nº equipamento
.Cells(last + 1, 3) = manutencaoexp.ComboBox5 'avaria
.Cells(last + 1, 4) = manutencaoexp.ComboBox4 'serviços
' .Cells(last + 1, 5) = Velocidade 'produtos
' .Cells(last + 1, 6) = Qualidade 'duração
' .Cells(last + 1, 7) = Data 'operario
.Cells(last + 1, 8) = manutencaoexp.ComboBox6 'tipo de manutenção
.Protect Password:="projmanutencao"
End With
src.Close True ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
ErrHandler:
If Err Then
Debug.Print "Error", Err.Number, Err.Description
Err.Clear
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
I'm currently on a project that search in a product database all non-referenced product (blank fields). When I click on the button that opens a userform, error 13 is displayed, here is the code:
Dim i As Integer
Dim j As Integer
Dim t As Integer
Dim r As Integer
t = 1
While Feuil3.Cells(t, 1) <> ""
t = t + 1
Wend
t = t - 1
For r = 2 To t
If Feuil3.Cells(r, 3) = "" Then
i = 1
While Feuil2.Cells(i, 1) <> ""
i = i + 1
Wend
Feuil2.Cells(i, 1) = Feuil3.Cells(r, 2)
End If
Next
i = 1
While Feuil2.Cells(i, 1) <> ""
i = i + 1
Wend
For j = 2 To i
If Feuil2.Cells(j, 2) = "" Then
list51.AddItem Feuil2.Cells(j, 1)
End If
Next
End Sub
It appears that the error comes from this line:If Feuil3.Cells(r, 3) = "" Then
My skills in VBA are limited, do you have any idea on how to fix this problem?
Thanks,
Have a look at this. Should do the same just a lot less iteratively
Dim Feuil2Rng As Range, Feuil3Rng As Range
Dim c
With Feuil3
Set Feuil3Rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
End With
For Each c In Feuil3Rng
If c.Offset(0, 2) = vbNullString Then
With Feuil2
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) = c.Offset(0,1)
End With
End If
Next
With Feuil2
Set Feuil2Rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
End With
For Each c In Feuil2Rng
If c.Offset(0, 1) = vbNullString Then
list51.AddItem c.Value2
End If
Next
I have made a userform that allows the user to select a table and add rows to it and fill those rows with various information, all from the userform. I have run into a few problems with this.
First after adding or during adding the items (after hitting submit) excel would crash. It occurs randomly and is hard to reproduce.
Second after running the macro there is a good chance that all the cells in the workbook and every other object except the userform button will stop working, meaning you can't edit interact or even select anything. Then when I close the workbook excel crashes after saving. This is my major offender and I think causes the other problem.
What causes this freezing and why does it occur? How do I fix it? I have looked around and haven't found anything circumstantial. One post said that I should try editing the table with no formatting on it and I did that and it didn't work.
I can provide the excel workbook at a request basis via pm.
The code:
On Activate -
Public Sub UserForm_Activate()
Set cBook = ThisWorkbook
Set dsheet = cBook.Sheets("DATA")
End Sub
Help Checkbox -
Private Sub cbHelp_Click()
If Me.cbHelp.Value = True Then
Me.lbHelp.Visible = True
Else
Me.lbHelp.Visible = False
End If
End Sub
Brand combobox -
Public Sub cmbBrand_Change()
brandTableName = cmbBrand.Value
brandTableName = CleanBrandTableName(brandTableName)
'if brand_edit is not = to a table name then error is thrown
On Error Resume Next
If Err = 380 Then
Exit Sub
Else
cmbItemID.RowSource = brandTableName
End If
On Error GoTo 0
'Set cmbItemID's text to nothing after changing to a new brand
cmbItemID.Text = ""
End Sub
CleanBrandTableName(brandTableName) function -
Option Explicit
Public Function CleanBrandTableName(ByVal brandTableName As String) As String
Dim s As Integer
Dim cleanResult As String
For s = 1 To Len(brandTableName)
Select Case Asc(Mid(brandTableName, s, 1))
Case 32, 48 To 57, 65 To 90, 97 To 122:
cleanResult = cleanResult & Mid(brandTableName, s, 1)
Case 95
cleanResult = cleanResult & " "
Case 38
cleanResult = cleanResult & "and"
End Select
Next s
CleanBrandTableName = Replace(WorksheetFunction.Trim(cleanResult), " ", "_")
End Function
Public Function CleanSpecHyperlink(ByVal specLink As String) As String
Dim cleanLink As Variant
cleanLink = specLink
cleanLink = Replace(cleanLink, "=HYPERLINK(", "")
cleanLink = Replace(cleanLink, ")", "")
cleanLink = Replace(cleanLink, ",", "")
cleanLink = Replace(cleanLink, """", "")
cleanLink = Replace(cleanLink, "Specs", "")
CleanSpecHyperlink = cleanLink
End Function
Browse button -
Public Sub cbBrowse_Click()
Dim rPos As Long
Dim lPos As Long
Dim dPos As Long
specLinkFileName = bFile
rPos = InStrRev(specLinkFileName, "\PDFS\")
lPos = Len(specLinkFileName)
dPos = lPos - rPos
specLinkFileName = Right(specLinkFileName, dPos)
Me.tbSpecLink.Text = specLinkFileName
End Sub
bFile function -
Option Explicit
Public Function bFile() As String
bFile = Application.GetOpenFilename(Title:="Please choose a file to open")
If bFile = "" Then
MsgBox "No file selected.", vbExclamation, "Sorry!"
Exit Function
End If
End Function
Preview button -
Private Sub cbSpecs_Click()
If specLinkFileName = "" Then Exit Sub
cBook.FollowHyperlink (specLinkFileName)
End Sub
Add Item button -
Private Sub cbAddItem_Click()
Dim brand As String
Dim description As String
Dim listPrice As Currency
Dim cost As Currency
Dim Notes As String
Dim other As Variant
itemID = Me.tbNewItem.Text
brand = Me.tbBrandName.Text
description = Me.tbDescription.Text
specLink = Replace(specLinkFileName, specLinkFileName, "=HYPERLINK(""" & specLinkFileName & """,""Specs"")")
If Me.tbListPrice.Text = "" Then
listPrice = 0
Else
listPrice = Me.tbListPrice.Text
End If
If Me.tbCost.Text = "" Then
cost = 0
Else
cost = Me.tbCost.Text
End If
Notes = Me.tbNotes.Text
other = Me.tbOther.Text
If Me.lbItemList.listCount = 0 Then
x = 0
End If
With Me.lbItemList
Me.lbItemList.ColumnCount = 8
.AddItem
.List(x, 0) = itemID
.List(x, 1) = brand
.List(x, 2) = description
.List(x, 3) = specLink
.List(x, 4) = listPrice
.List(x, 5) = cost
.List(x, 6) = Notes
.List(x, 7) = other
x = x + 1
End With
End Sub
Submit button -
Private Sub cbSubmit_Click()
Dim n As Long
Dim v As Long
Dim vTable() As Variant
Dim r As Long
Dim o As Long
Dim c As Long
Dim w As Variant
Set brandTable = dsheet.ListObjects(brandTableName)
o = 1
listAmount = lbItemList.listCount
v = brandTable.ListRows.Count
w = 0
For c = 1 To listAmount
If brandTable.ListRows(v).Range(, 1).Value <> "" Then
brandTable.ListRows.Add alwaysinsert:=True
brandTable.ListRows.Add alwaysinsert:=True
Else
brandTable.ListRows.Add alwaysinsert:=True
End If
Next
ReDim vTable(1000, 1 To 10)
For n = 0 To listAmount - 1
vTable(n + 1, 1) = lbItemList.List(n, 0)
vTable(n + 1, 2) = lbItemList.List(n, 1)
vTable(n + 1, 3) = lbItemList.List(n, 2)
vTable(n + 1, 5) = lbItemList.List(n, 4)
vTable(n + 1, 6) = lbItemList.List(n, 5)
vTable(n + 1, 7) = lbItemList.List(n, 6)
vTable(n + 1, 8) = lbItemList.List(n, 7)
If lbItemList.List(n, 3) = "" Then
ElseIf lbItemList.List(n, 3) <> "" Then
vTable(n + 1, 4) = lbItemList.List(n, 3)
End If
If n = 0 And brandTable.DataBodyRange(1, 1) <> "" Then
For r = 1 To brandTable.ListRows.Count
If brandTable.DataBodyRange(r, 1) <> "" Then
o = r + 1
' brandTable.ListRows.Add alwaysinsert:=True
End If
Next
End If
brandTable.ListColumns(1).DataBodyRange(n + o).Value = vTable(n + 1, 1)
brandTable.ListColumns(2).DataBodyRange(n + o).Value = vTable(n + 1, 2)
brandTable.ListColumns(3).DataBodyRange(n + o).Value = vTable(n + 1, 3)
brandTable.ListColumns(4).DataBodyRange(n + o).Value = vTable(n + 1, 4)
brandTable.ListColumns(5).DataBodyRange(n + o).Value = vTable(n + 1, 5)
brandTable.ListColumns(6).DataBodyRange(n + o).Value = vTable(n + 1, 6)
brandTable.ListColumns(7).DataBodyRange(n + o).Value = vTable(n + 1, 7)
brandTable.ListColumns(8).DataBodyRange(n + o).Value = vTable(n + 1, 8)
Next
brandTable.DataBodyRange.Select
Selection.Font.Bold = True
Selection.WrapText = True
brandTable.ListColumns(5).DataBodyRange.Select
Selection.NumberFormat = "$#,##0.00"
brandTable.ListColumns(6).DataBodyRange.Select
Selection.NumberFormat = "$#,##0.00"
Unload Me
End Sub
Remove Items button -
Private Sub cbRemoveItems_Click()
Dim intCount As Long
For intCount = lbItemList.listCount - 1 To 0 Step -1
If lbItemList.Selected(intCount) Then
lbItemList.RemoveItem (intCount)
x = x - 1
End If
Next intCount
End Sub
There is other code that does things for the other tabs but they don't interact with this tabs code.
I want to add many option button to an excel worksheet (not to a VBA-form) and want to group them by row. The result should look something like this:
Here is the code I'm using so far:
For d = 1 To 31
Set checkboxKrankCell = Range("H" + Trim(Str(d)))
Set checkboxUrlaubCell = Range("I" + Trim(Str(d)))
Set checkboxJazCell = Range("J" + Trim(Str(d)))
groupWidth = checkboxKrankCell.Width + checkboxUrlaubCell.Width + checkboxJazCell.Width
Set groupBoxOptionButtons = ActiveSheet.GroupBoxes.Add(checkboxKrankCell.Left - 1, checkboxKrankCell.Top - 2, groupWidth + 1, checkboxKrankCell.Height)
With groupBoxOptionButtons
.Name = "GroupBox_" + Trim(Str(d))
.Caption = ""
End With
Set checkboxKrank = ActiveSheet.OptionButtons.Add(checkboxKrankCell.Left, checkboxKrankCell.Top - 1, checkboxKrankCell.Width, checkboxKrankCell.Height)
With checkboxKrank
.Caption = ""
End With
#1 checkboxKrank.GroupBox = groupBoxOptionButtons
Set checkboxUrlaub = ActiveSheet.OptionButtons.Add(checkboxUrlaubCell.Left, checkboxUrlaubCell.Top - 1, checkboxUrlaubCell.Width, checkboxUrlaubCell.Height)
With checkboxUrlaub
.Caption = ""
End With
Set checkboxJaz = ActiveSheet.OptionButtons.Add(checkboxJazCell.Left, checkboxJazCell.Top - 1, checkboxJazCell.Width, checkboxJazCell.Height)
With checkboxJaz
.Caption = ""
#2 .GroupBox = groupBoxOptionButtons
End With
Next d
I would expect to assign the option buttons to the group for the current row by setting the GroupBox property (see #1 or #2).
But both methods just gave me an error saying 'The object does not support the property or methode'.
Any help or hint is welcome ;-)
Based on the tip from snb I have modified my function like this:
Sub AddOptionButtons()
ActiveSheet.OptionButtons.Delete
For d = 1 To 31
Set checkboxKrankCell = Range("H" + Trim(Str(d + 4)))
Set checkboxUrlaubCell = Range("I" + Trim(Str(d + 4)))
Set checkboxJazCell = Range("J" + Trim(Str(d + 4)))
option1Name = "Krank_" + Trim(Str(d))
option2Name = "Urlaub_" + Trim(Str(d))
option3Name = "Jaz_" + Trim(Str(d))
Set checkboxKrank = ActiveSheet.OptionButtons.Add(checkboxKrankCell.Left, checkboxKrankCell.Top - 1, checkboxKrankCell.Width, checkboxKrankCell.Height)
With checkboxKrank
.Caption = ""
.Name = option1Name
End With
Set checkboxUrlaub = ActiveSheet.OptionButtons.Add(checkboxUrlaubCell.Left, checkboxUrlaubCell.Top - 1, checkboxUrlaubCell.Width, checkboxUrlaubCell.Height)
With checkboxUrlaub
.Caption = ""
.Name = option2Name
End With
Set checkboxJaz = ActiveSheet.OptionButtons.Add(checkboxJazCell.Left, checkboxJazCell.Top - 1, checkboxJazCell.Width, checkboxJazCell.Height)
With checkboxJaz
.Caption = ""
.Name = option3Name
End With
ActiveSheet.Shapes.Range(Array(option1Name, option2Name, option3Name)).Group
Next d
End Sub
I don't get any errors using Shapes.Range(...).Group.
But still all option buttons from on the sheet are all mutual exclusive.
Seems grouping does not work here.
Try the following code on an empty workbook. It will give you an option to choose only ONE optionbutton on each row, which is what you want, as far as I understood (I also created a linked cell reference, just in case you would like to take further action, given the choice of a user.):
Sub AddOptionButtons()
Dim btn1 As OptionButton
Dim btn2 As OptionButton
Dim btn3 As OptionButton
Dim grbox As GroupBox
Dim t As Range
Dim s As Range
Dim p As Range
Dim i As Integer
ActiveSheet.OptionButtons.Delete
ActiveSheet.GroupBoxes.Delete
For i = 5 To 35 Step 1
Set t = ActiveSheet.Range(Cells(i, 8), Cells(i, 8))
Set s = ActiveSheet.Range(Cells(i, 9), Cells(i, 9))
Set p = ActiveSheet.Range(Cells(i, 10), Cells(i, 10))
Set btn1 = ActiveSheet.OptionButtons.Add(t.Left, t.Top, t.Width, t.Height)
Set btn2 = ActiveSheet.OptionButtons.Add(s.Left, s.Top, s.Width, s.Height)
Set btn3 = ActiveSheet.OptionButtons.Add(p.Left, p.Top, p.Width, p.Height)
Set grbox = ActiveSheet.GroupBoxes.Add(t.Left, t.Top, t.Width + 100, t.Height)
With btn1
.Caption = ""
.Display3DShading = True
.LinkedCell = "M" & i
End With
With btn2
.Caption = ""
.Display3DShading = True
End With
With btn3
.Caption = ""
.Display3DShading = True
End With
With grbox
.Caption = ""
.Visible = False
End With
Next i
End Sub
I'd use:
Sub M_snb()
ReDim sn(2)
For j = 1 To 2
For jj = 1 To 3
With Sheet1.OptionButtons.Add(Cells(j, jj).Left, Cells(j, jj).Top - 1, Cells(j, jj).Width, Cells(j, jj).Height)
sn(jj - 1) = .Name
End With
Next
Sheet1.Shapes.Range(sn).Group
Next
End Sub
The code works fine when I dont use the first command to clear contents.After clearing the contents I got a "Paste Special Error" when I used the command to consolidate certain rows and columns.I need to reduce the size of certain rows and columns(wrap text) as it is taking a lot of space
Private Sub Btn_clear_Click()
ThisWorkbook.Worksheets("Main").Cells.ClearContents
End Sub
(I am to able to clear the cell contents using this)
Sub Credit_Risk_Components()
Const FOLDER As String = "C:\SBI_Files\"
Const cStrWSName As String = "Credit Risk Components"
'(I got a paste value error here)
On Error GoTo ErrorHandler
Dim i As Integer
Dim fileName As String
' Cleaning Credit Indicators (Both amount and percentage) '
ThisWorkbook.Worksheets(cStrWSName).Range("C8:C16").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C20").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C23:C25").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C40:C47").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C52:C59").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C66").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C68").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C71:C73").ClearContents
'Cleaning the Annexure Section'
ThisWorkbook.Worksheets(cStrWSName).Range("H6:K200").UnMerge
ThisWorkbook.Worksheets(cStrWSName).Range("H6:K200").ClearFormats
ThisWorkbook.Worksheets(cStrWSName).Range("H6:K200").ClearContents
(I want to resize certain rows and columns,as the rows and columns are taking a lot of space which isn't required)
'Building the Annexure Section'
ThisWorkbook.Worksheets(cStrWSName).Range("H4").Value = "Annexure I"
ThisWorkbook.Worksheets(cStrWSName).Range("H4:K4").Merge
ThisWorkbook.Worksheets(cStrWSName).Range("H4:K4").HorizontalAlignment = xlCenter
ThisWorkbook.Worksheets(cStrWSName).Range("H4:K4").Font.Bold = True
ThisWorkbook.Worksheets(cStrWSName).Cells(5, 2).Copy Cells(5, 9)
ThisWorkbook.Worksheets(cStrWSName).Cells(5, 3).Copy Cells(5, 10)
ThisWorkbook.Worksheets(cStrWSName).Cells(5, 4).Copy Cells(5, 11)
fileName = Dir(FOLDER, vbDirectory)
Do While Len(fileName) > 0
If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then
i = i + 1
Dim currentWkbk As Excel.Workbook
Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
ThisWorkbook.Worksheets(cStrWSName).Range("C10").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C10").Value + currentWkbk.Sheets(cStrWSName).Range("C10").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C11").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C11").Value + currentWkbk.Sheets(cStrWSName).Range("C11").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C13").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C13").Value + currentWkbk.Sheets(cStrWSName).Range("C13").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C14").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C14").Value + currentWkbk.Sheets(cStrWSName).Range("C14").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C16").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C16").Value + currentWkbk.Sheets(cStrWSName).Range("C16").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C20").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C20").Value + currentWkbk.Sheets(cStrWSName).Range("C20").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C23").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C23").Value + currentWkbk.Sheets(cStrWSName).Range("C23").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C24").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C24").Value + currentWkbk.Sheets(cStrWSName).Range("C24").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C25").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C25").Value + currentWkbk.Sheets(cStrWSName).Range("C25").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C40").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C40").Value + currentWkbk.Sheets(cStrWSName).Range("C40").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C41").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C41").Value + currentWkbk.Sheets(cStrWSName).Range("C41").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C42").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C42").Value + currentWkbk.Sheets(cStrWSName).Range("C42").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C43").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C43").Value + currentWkbk.Sheets(cStrWSName).Range("C43").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C44").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C44").Value + currentWkbk.Sheets(cStrWSName).Range("C44").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C45").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C45").Value + currentWkbk.Sheets(cStrWSName).Range("C45").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C46").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C46").Value + currentWkbk.Sheets(cStrWSName).Range("C46").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C47").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C47").Value + currentWkbk.Sheets(cStrWSName).Range("C47").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C52").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C52").Value + currentWkbk.Sheets(cStrWSName).Range("C52").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C53").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C53").Value + currentWkbk.Sheets(cStrWSName).Range("C53").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C54").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C54").Value + currentWkbk.Sheets(cStrWSName).Range("C54").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C56").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C56").Value + currentWkbk.Sheets(cStrWSName).Range("C56").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C57").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C57").Value + currentWkbk.Sheets(cStrWSName).Range("C57").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C58").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C58").Value + currentWkbk.Sheets(cStrWSName).Range("C58").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C59").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C59").Value + currentWkbk.Sheets(cStrWSName).Range("C59").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C66").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C66").Value + currentWkbk.Sheets(cStrWSName).Range("C66").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C68").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C68").Value + currentWkbk.Sheets(cStrWSName).Range("C68").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C71").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C71").Value + currentWkbk.Sheets(cStrWSName).Range("C71").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C72").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C72").Value + currentWkbk.Sheets(cStrWSName).Range("C72").Value
ThisWorkbook.Worksheets(cStrWSName).Range("C73").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C73").Value + currentWkbk.Sheets(cStrWSName).Range("C73").Value
'Adding the Prudential/ Industrial Exposures to the annexure'
rowNum = Range("I65536").End(xlUp).Row
ThisWorkbook.Worksheets(cStrWSName).Cells(rowNum + 1, 8).Value = Left(currentWkbk.Name, Len(currentWkbk.Name) - 4)
ThisWorkbook.Worksheets(cStrWSName).Cells(rowNum + 1, 8).Font.Bold = True
currentWkbk.Sheets(cStrWSName).Range("B29:D38").Copy
ThisWorkbook.Worksheets(cStrWSName).Range(Cells(rowNum + 2, 9), Cells(rowNum + 11, 11)).PasteSpecial xlPasteValues
ThisWorkbook.Worksheets(cStrWSName).Range(Cells(rowNum + 2, 9), Cells(rowNum + 11, 11)).PasteSpecial xlPasteFormats
currentWkbk.Sheets(cStrWSName).Range("B76:D79").Copy
ThisWorkbook.Worksheets(cStrWSName).Range(Cells(rowNum + 12, 9), Cells(rowNum + 15, 11)).PasteSpecial xlPasteValues
ThisWorkbook.Worksheets(cStrWSName).Range(Cells(rowNum + 12, 9), Cells(rowNum + 15, 11)).PasteSpecial xlPasteFormats
currentWkbk.Close
End If
fileName = Dir
Loop
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Comment out error handler and check what line fails.
FYI, .xlsx does not allow any code (unless your code is run outside).
Based on your error message there is something wrong with PasteSpecial method you use in the end. Try copying the same manually.
BTW, your code should be refactored.