粘贴后停用整个纸张选择

时间:2017-07-25 20:07:17

标签: excel vba excel-vba

我最近问了一个问题并在这个网站上得到了很好的答案,但我现在遇到了另一个问题。下面的代码适用于运行文件夹中的每个工作簿,复制工作表的内容,并将这些内容完全粘贴到主工作簿中:

def myfunction(obj):
    if isinstance(obj, list):
        # when the object is a list
    elif isinstance(obj, MyClass):
        # when the object is something else
    else:
        raise ValueError('wrong type!')

我现在遇到的问题:粘贴完成后,主工作簿中的每个工作表都选中了所有单元格,就好像我Sub ConslidateWorkbooks() 'Code to pull sheets from multiple Excel files in one file directory 'into master "Consolidation" sheet. Dim FolderPath As String Dim Filename As String Dim Sheet As Worksheet Dim wbName As String With ActiveSheet Range("A1").Activate End With Application.ScreenUpdating = False FolderPath = ActiveWorkbook.Path & "\" Filename = Dir(FolderPath & "*.xls*") wbName = ActiveWorkbook.Name Do While Filename <> "" If Filename <> wbName Then Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets copyOrRefreshSheet ThisWorkbook, Sheet Next Sheet Workbooks(Filename).Saved = True Workbooks(Filename).Close ActiveSheet.Range("A1").Activate End If Filename = Dir() Loop Application.ScreenUpdating = True End Sub Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet) Dim ws As Worksheet On Error Resume Next Set ws = destWb.Worksheets(sourceWs.Name) On Error GoTo 0 If ws Is Nothing Then sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.Count) Else ws.Unprotect Password:="abc123" ws.Cells.ClearContents sourceWs.UsedRange.Copy ws.Range(sourceWs.UsedRange.Address).PasteSpecial (xlPasteAll) Application.CutCopyMode = False End If End Sub 整个工作表一样。我想摆脱这个。我试图在Ctrl+A循环中的ActiveSheet.Range("A1").Activate行中完成这项小任务,但它对我没用。

修改

我找到了一个适合这种情况的解决方案。我不确定为什么这是必要的,因为这个帖子中的评论和答案似乎应该工作,但他们没有。在我将Do While ..转换为主要子版中的sub之前,我称之为screenupdating

True

我意识到这比它应该更复杂,但它适用于我的目的。

1 个答案:

答案 0 :(得分:0)

在你的复制子中,在循环中添加另一个代码,该代码将选择一个单元格,该单元格应该停用总使用范围选择并只选择编码范围。

Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet)
Dim ws As Worksheet
On Error Resume Next
Set ws = destWb.Worksheets(sourceWs.Name)
On Error GoTo 0
If ws Is Nothing Then
    sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.Count)
Else
    ws.Unprotect Password:="abc123"
    ws.Cells.ClearContents
    sourceWs.UsedRange.Copy
    ws.Range(sourceWs.UsedRange.Address).PasteSpecial (xlPasteAll)
    ws.range("A1").select
    Application.CutCopyMode = False
    End If
End Sub

我添加了ws.range("A1").select,这应该像我上面所描述的那样。