Deselect Multiple sheet and select the Summary Sheet - VBA

[Shreesurya]

Hello Everyone,

This is my First Thread in Mr.Excel

I have bunch of Workbooks in One of the shared folder, and I am looping the (Summary) Sheet in all the workbooks to one main workbook,

However my issue is, for some of the workbooks (Multiple sheets were selected)

Need you help to correct the code to Deselect the sheets if multiple sheets were selected and to select the one sheet which I need to copy.

Thanks in Advance for your response

 

[jim may]

Could you post that portion of your existing code that deals with your concern?

 

[Shreesurya]

Here is the Code,

and the error msg is

Run-time Error'1004':
The Information cannot be pasted because the copy area and the paste area are not the same size and shape. try one of the following,

- Click on single cell, and then paste
- select a rectangle that's the same size and shape and then paste.

"""" This will not happen when Mulitple sheets were not selected """

E]Sub MergeLocationFiles()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, Sht_LocDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
ThisWB = ActiveWorkbook.Name
'Range("A1").Select
Dim TheLastRow As Long
'TheLastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
With ActiveSheet
TheLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
ThisWorkbook.Sheets("Location").Range("A2:Z1048576").Clear
ThisWorkbook.Save

path = ("T:\Consumer Lending\Schoone\BPO dashboard\RCC Production Report Template\Production log\Current Month")
'Modify this path to show the path
'ActiveSheet.UsedRange
'path = ActiveWorkbook.path
Application.ScreenUpdating = False
Set Sht_LocDest = ActiveWorkbook.Sheets("Location")
Filename = Dir(path & "\*.xls*", vbNormal)
If Len(Filename) = 0 Then Exit Sub

Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename, ReadOnly:=True, UpdateLinks:=False)
Application.StatusBar = Wkb.Name
'Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
If Wkb.Sheets("Summary").Visible = False Then
Wkb.Sheets("Summary").Visible = True
End If
Wkb.Sheets("Summary").Calculate
Set CopyRng = Wkb.Sheets("Summary").Range("BQ11:CM2000")
CopyRng.Copy
ThisWorkbook.Activate
ActiveWorkbook.Sheets("Location").Select
'Range("A1").Select
TheLastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Set Dest = Sht_LocDest.Range("A" & TheLastRow + 1)
Dest.PasteSpecial xlPasteValuesAndNumberFormats

Application.CutCopyMode = False 'Clear Clipboard

Wkb.Close False
End If
Filename = Dir()
Loop
ThisWorkbook.Sheets("Location").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False

MsgBox "All Process Data has been copied Sucessfully"
End Sub

[/CODE]