且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

将Excel数据从多个工作表复制到一个工作表中

更新时间:2022-12-11 23:21:47

大规模

与上一次与Iain聊天时一样,已经设置了正确的参数.我删除了最后几个代码段,因为它们不太正确.如果仍然有兴趣,请检查编辑历史记录.

As with last chat with Iain, the correct parameters have been set. I have removed the last few code snippets as they are quite not right. If anyone is still interested, please check the edit history.

希望这是最终的编辑. ;)

Hopefully, this is the final edit. ;)

因此,所需的正确条件是:

So, the correct conditions needed are:

  1. 工作表中的月份名称.我们为此使用了一个输入框.
  2. 我们检查行数.有三个条件:总共157行,总共41行以及所有其他条件.

下面的子例程可以解决问题.

The following subroutine will do the trick.

Sub BlackwoodTransfer()

    Dim Summ As Worksheet, Ws As Worksheet
    Dim ShName As String
    Dim nRow As Long

    Set Summ = ThisWorkbook.Sheets("Summary")
    ShName = InputBox("Enter month for Call Flow in mmmm format (ie. November, etc.):") & " Call Flow"
    'Returns November Call Flow. This means it will target every sheet that has November Call Flow in its name.

    Application.ScreenUpdating = False

    For Each Ws In ThisWorkbook.Worksheets
        If InStr(1, Ws.Name, ShName) > 0 Then
        'Starting from first character of the sheet's name, if it has November, then...
            nRow = Summ.Cells(Rows.Count, 1).End(xlUp).Row + 1
            '... get the next empty row of the Summary sheet...
            Select Case Ws.Cells(Rows.Count, 1).End(xlUp).Row
            '... check how many rows this qualified sheet has...
                Case 157
                '... if there are 157 rows total...
                    Ws.Range(Cells(57,1),Cells(104,13)).Copy
                    '... copy Rows 57 to 104, 13 columns wide...
                    Summ.Range("A" & nRow).PasteSpecial xlPasteAll
                    '... and paste to next empty row in Summary sheet.
                Case 41
                    Ws.Range(Cells(23,1),Cells(126,13)).Copy
                    Summ.Range("A" & nRow).PasteSpecial xlPasteAll               
                Case Else
                    Ws.Range(Cells(23,1),Cells(30,13)).Copy
                    Summ.Range("A" & nRow).PasteSpecial xlPasteAll
            End Select
        End If
    Next Ws

    Application.ScreenUpdating = True

End Sub

@Iain:签出注释,并将其与MSDN数据库交叉引用.那应该解释每个功能/方法的确切作用.希望这会有所帮助!

@Iain: Check out the comments and cross reference them with the MSDN database. That should explain what each function/method is doing exactly. Hope this helps!