Question

我的第一篇文章..... 我能够从Siddharth Rout中搜索并找到这个代码，这是我想要做的基础....将多张数据附加到单个数据表中。但是我在修改它以适应我的情况时遇到了麻烦。我下面的内容目前还没有......

问题1）如何使用Select Case InStr，其中多张表（3）没有通用名称，例如＆＃34; Legende＆＃34;正如她原来的海报一样。

问题2）在我的情况下，每个工作表将有不同的列，我需要复制到Tab_Appended表，Sheet1将有x行，我想要列B，D，M，AR等，Sheet2将有XXXX行和我想要将B，D，N，AS，AT等列复制15张。

感谢Siddharth Rout的原始代码：

Sub SummurizeSheets()
Dim wsOutput As Worksheet
Dim ws As Worksheet
Dim wsOLr As Long, wsLr As Long

Application.ScreenUpdating = False

'~~> Set this to the sheet where the output will be dumped
Set wsOutput = Sheets("Tab_Appended")

With wsOutput
    '~~> Get Last Row in "Tab_Appended" in Col A/M and Add 1 to it
    wsOLr = .Range("A:M").Find(What:="*", After:=.Range("A1"), _
            Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False).Row + 1

    '~~> Loop through sheet
    For Each ws In Worksheets
        '~~> Check if the sheet name has Legende
        'Select Case InStr(1, ws.Name, "Legende", vbTextCompare)
        Select Case InStr(1, ws.Name, "Test2", vbTextCompare) + _
        InStr(1, strData, "Test", vbTextCompare) + _
        InStr(1, strData, "Sheet2", vbTextCompare)

        '~~> If not then
        Case 0
            With ws
                '~~> Get Last Row in the sheet
                wsLr = .Range("A:M").Find(What:="*", After:=.Range("A1"), _
                       Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, MatchCase:=False).Row

                '~~> Copy the relevant range
                .Range("A2:M" & wsLr).Copy wsOutput.Range("A" & wsOLr)

                '~~> Get Last Row AGAIN in "Tab_Appended" in Col A/B and Add 1 to it
                wsOLr = wsOutput.Range("A:M").Find(What:="*", After:=wsOutput.Range("A1"), _
                        Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, MatchCase:=False).Row + 1
            End With
        End Select
    Next
End With

Application.ScreenUpdating = True
End Sub

谢谢，唐

将In Case用于多个命名工作表的Select Case

0 个答案: