如何设置字符串以查找工作表

时间:2016-12-06 08:38:50

标签: excel-vba vba excel

如果工作表名称为" Central" (在单词的末尾有一个空格),zone =" Central"返回错误,无法激活工作表。

我如何纠正这个?

dim wb1, wb2, wb3 as workbook
    set wb1 = activeworkbook 'the macro file
dim ws1, ws2 as worksheet
set ws1 = Sheets("Central Zone")
set ws2 = Sheets("Eastern Zone")

For x = 1 To 2
    If x = 1 Then
        Set ws = ws1
        zone = "Central"
    End If
    If x = 2 Then
        Set ws = ws2
        zone = "East"
    End If


    wb2.Sheets(zone).Activate 'wb2 is source file 1. I have wb3, wb4, etc
        Selection.EntireColumn.Hidden = False
        Range("A1").Select
        Selection.End(xlDown).Select
        Range(Selection, Selection.End(xlUp)).Select
        Selection.EntireRow.Select
        Selection.Copy
    wb1.Activate
    ws.Activate
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Range("A1").Select
        Selection.End(xlDown).Offset(1, 0).Select
Next x

1 个答案:

答案 0 :(得分:0)

总是建议远离ActivateSelectionSelect以及所有其他"亲戚"。而是使用引用的对象,如Sheets和`范围。

下面的代码有点“快速而又脏”"但它应该给你想要的结果

<强>代码

Option Explicit

Sub CopyCentralSheets()

Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, Sht As Worksheet, ws As Worksheet
Dim LastRow As Long, LastColumn As Long, PasteRow As Long, x As Long

Set wb1 = ThisWorkbook  ' this macro file
'Set wb2 = Workbooks("temp.xlsx")  'for my debug tests only

Set ws1 = wb1.Sheets("Central Zone")
Set ws2 = wb1.Sheets("Eastern Zone")

For x = 1 To 2
    If x = 1 Then
        For Each Sht In wb2.Worksheets
            If Sht.Name Like "Central*" Then
                Set ws = Sht
            End If
        Next Sht
    Else
        If x = 2 Then
            For Each Sht In wb2.Worksheets
                If Sht.Name = "East" Then
                    Set ws = Sht
                End If
            Next Sht
        End If
    End If

    With ws
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        LastColumn = .UsedRange.Columns(.UsedRange.Columns.Count).Column
        .Range(.Cells(1, 1), .Cells(LastRow, LastColumn)).Copy                
    End With

    If x = 1 Then
        With ws1
            PasteRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("A" & PasteRow + 1).PasteSpecial xlValues
        End With
    Else
        If x = 2 Then
            With ws2
                PasteRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                .Range("A" & PasteRow + 1).PasteSpecial xlValues
            End With
        End If
    End If
Next x

End Sub