Код выдает ошибку отладки, теперь он работал хорошо, я не знаю почему. Может кто-нибудь решить проблему. Все папки и листы имеют то же имя, что и раньше, но ошибка в том, что файлы или расположение были удалены или переименованы. С нетерпением жду вашего ответа.
Этот код работал отлично пару дней назад, но теперь в нем есть ошибка, пожалуйста, обратите внимание на проблему. что это можно исправить
Public fName As String, _
fd As FileDialog, _
wbOne As Workbook, wbTwo As Workbook, tw As Workbook, NewBook1 As Workbook, NewBook2 As Workbook, _
shOne As Worksheet, shTwo As Worksheet, sh As Worksheet, actOne As Worksheet, actTwo As Worksheet, _
shResult As Worksheet, actResult_1 As Worksheet, actResult_2 As Worksheet, _
fChosen As Integer
Sub ExecuteBtn()
Dim linkOne As String
Dim linkTwo As String
Dim nrRowsOne As Long
Dim nrRowsTwo As Long
Dim nrRowsStart As Long
Dim nrRowsResult1 As Long
Dim nrRowsResult2 As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set tw = ThisWorkbook
Set sh = tw.Worksheets("Start")
nrRowsStart = NrRows(sh, 1)
For j = 2 To nrRowsStart
fName = sh.Cells(j, 1).Value
linkOne = ThisWorkbook.Path & "\cell are codes\" & fName & ".csv"
linkTwo = ThisWorkbook.Path & "\Landline Area codes\Landline Area codes Prefixes-" & fName & ".csv"
Set wbOne = Workbooks.Open(linkOne)
Set actOne = wbOne.Worksheets(1)
nrRowsOne = NrRows(actOne, 1)
Set wbTwo = Workbooks.Open(linkTwo)
Set actTwo = wbTwo.Worksheets(1)
nrRowsTwo = NrRows(actTwo, 1)
nrRowsResult1 = 2
nrRowsResult2 = 2
If nrRowsOne <= 1048576 Then
If nrRowsOne = nrRowsTwo Then
If nrRowsOne <= 524288 Then AddNew1 (tw.Path & "\Result\Result" & fName & "_1" & ".xlsx")
If nrRowsOne > 524288 Then AddNew1 (tw.Path & "\Result\Result" & fName & "_1" & ".xlsx"): AddNew2 (tw.Path & "\Result\Result" & fName & "_2" & ".xlsx")
For i = 2 To nrRowsOne
If i <= 524288 Then
actResult_1.Range("A1:G1").Value = actOne.Range("A1:G1").Value
actResult_1.Range("A" & nrRowsResult1 & ":G" & nrRowsResult1).Value = actOne.Range("A" & i & ":G" & i).Value
actResult_1.Range("A" & nrRowsResult1 + 1 & ":G" & nrRowsResult1 + 1).Value = actTwo.Range("A" & i & ":G" & i).Value
nrRowsResult1 = nrRowsResult1 + 2
Else
actResult_2.Range("A1:G1").Value = actOne.Range("A1:G1").Value
actResult_2.Range("A" & nrRowsResult2 & ":G" & nrRowsResult2).Value = actOne.Range("A" & i & ":G" & i).Value
actResult_2.Range("A" & nrRowsResult2 + 1 & ":G" & nrRowsResult2 + 1).Value = actTwo.Range("A" & i & ":G" & i).Value
nrRowsResult2 = nrRowsResult2 + 2
End If
Next i
Else
MsgBox "The files have different number of rows !", vbCritical
End If
Else
MsgBox "Excel cannot handle more than 1,048,576 rows !", vbCritical
End If
If nrRowsOne <= 524288 Then
NewBook1.SaveAs Filename:=tw.Path & "\Result\Result" & fName & "_1" & ".csv", FileFormat:=xlCSV, CreateBackup:=False
NewBook1.Close SaveChanges:=False
Kill (tw.Path & "\Result\Result" & fName & "_1" & ".xlsx")
End If
If nrRowsOne > 524288 Then
NewBook1.SaveAs Filename:=tw.Path & "\Result\Result" & fName & "_1" & ".csv", FileFormat:=xlCSV, CreateBackup:=False
NewBook1.Close SaveChanges:=False
Kill (tw.Path & "\Result\Result" & fName & "_1" & ".xlsx")
NewBook2.SaveAs Filename:=tw.Path & "\Result\Result" & fName & "_2" & ".csv", FileFormat:=xlCSV, CreateBackup:=False
NewBook2.Close SaveChanges:=False
Kill (tw.Path & "\Result\Result" & fName & "_2" & ".xlsx")
End If
wbOne.Close SaveChanges:=False
wbTwo.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Next j
MsgBox "Done !", vbInformation
End Sub
Sub AddNew1(locationPath As String)
Set NewBook1 = Workbooks.Add
With NewBook1
.SaveAs Filename:=locationPath
Set actResult_1 = .Worksheets(1)
End With
End Sub
Sub AddNew2(locationPath As String)
Set NewBook2 = Workbooks.Add
With NewBook2
.SaveAs Filename:=locationPath
Set actResult_2 = .Worksheets(1)
End With
End Sub
Function NrRows(sh As Worksheet, ColNumber As Integer) As Long
NrRows = sh.Cells(Rows.Count, ColNumber).End(xlUp).row
End Function