Getting Hanged in my Program

rajguptaji · Apr 16th 2020

Code

Sub RoundedRectangle2_Click()
Dim temp As Workbook
Dim ws As Worksheet
Dim w_dpr1  As Worksheet
Dim w_dpr2  As Worksheet
Dim W_dpr3  As Worksheet
Dim W_dpr4  As Worksheet
Dim W_dpr5  As Worksheet
Dim w_dpr6  As Worksheet
Dim w_dpr7  As Worksheet
Dim w_dpr8  As Worksheet
Dim w_dpr9  As Worksheet
Dim w_dpr10  As Worksheet
Dim w_dpr11  As Worksheet
Dim w_dpr12  As Worksheet
Dim w_dpr13  As Worksheet
Dim i As Long
Dim ii As Long
Application.Calculation = xlManual
Set wkb = ThisWorkbook


Set w_dpr1 = wkb.Sheets("INSTALL(WIP)")
Set w_dpr2 = wkb.Sheets("VTA(WIP)")
Set W_dpr3 = wkb.Sheets("Disconnect(WIP)")
Set W_dpr4 = wkb.Sheets("Change(WIP)")
Set W_dpr5 = wkb.Sheets("TSP(WIP)")
Set w_dpr6 = wkb.Sheets("Test & Accept Queue")
Set w_dpr7 = wkb.Sheets("Cancel Orders")
Set w_dpr8 = wkb.Sheets("Onshore Reassignment")
Set w_dpr9 = wkb.Sheets("RTP- WIP")
Set w_dpr10 = wkb.Sheets("RTP- RESOLVED")
Set w_dpr11 = wkb.Sheets("AD- Follow up")
Set w_dpr12 = wkb.Sheets("CCD")
Set w_dpr13 = wkb.Sheets("ClickIT Tickets")


w_dpr1.Range("A2:Z100000").ClearContents
w_dpr2.Range("A2:Z100000").ClearContents
W_dpr3.Range("A2:Z100000").ClearContents
W_dpr4.Range("A2:Z100000").ClearContents
W_dpr5.Range("A2:AA10000").ClearContents
w_dpr6.Range("A2:Z1000000").ClearContents
w_dpr7.Range("A2:Z1000000").ClearContents
w_dpr8.Range("A2:Z1000000").ClearContents
w_dpr9.Range("A2:Z1000000").ClearContents
w_dpr10.Range("A2:Z1000000").ClearContents
w_dpr11.Range("A2:Z1000000").ClearContents
w_dpr12.Range("A2:Z1000000").ClearContents
w_dpr13.Range("A2:Z1000000").ClearContents


MyFolder = wkb.Sheets("Overall Snapshot").Range("AQ1").Value
MyFile = Dir(MyFolder & "\*.xls*")
Application.DisplayAlerts = False
Do While MyFile <> ""
Set temp = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)


For Each ws In temp.Worksheets


If ws.Name = "INSTALL(WIP)" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr1.Activate
w_dpr1.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "VTA(WIP)" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr2.Activate
w_dpr2.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False




ElseIf ws.Name = "Disconnect(WIP)" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
W_dpr3.Activate
W_dpr3.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "Change(WIP)" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
W_dpr4.Activate
W_dpr4.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "TSP(WIP)" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
W_dpr5.Activate
W_dpr5.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "Test & Accept Queue" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr6.Activate
w_dpr6.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "Cancel Orders" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr7.Activate
w_dpr7.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "Onshore Reassignment" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr8.Activate
w_dpr8.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "RTP- WIP" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr9.Activate
w_dpr9.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "RTP- RESOLVED" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr10.Activate
w_dpr10.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "AD- Follow up" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr11.Activate
w_dpr11.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "CCD" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr12.Activate
w_dpr12.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


ElseIf ws.Name = "ClickIT Tickets" Then
temp.Activate
ws.Activate
i = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ws.Range("A2:Z" & i).Copy
ThisWorkbook.Activate
w_dpr13.Activate
w_dpr13.Range("A" & 2).PasteSpecial
Application.CutCopyMode = False


End If
Next
temp.Close no
MyFile = Dir
Loop


Application.Calculation = xlCalculationAutomatic


End Sub

Display More

**alansidman** · Apr 16th 2020

Please re-read the forum rules you agreed to when you joined. Pay particular attention to the rule regarding Code Tags. Once you have read the rules and understand them, please update your thread to include Code Tags.

No help to be offered this OP until this moderation request is complied with and code tags are added to the post.

**royUK** · Apr 17th 2020

I've added code tags because you cannot now. You won't get any help though just by posting code. You need to state clearly what the code is supposed to do and what the problems are. We aren't mind readers.

Getting Hanged in my Program

Participate now!

Share

Tags