VBA循环将工作表中的单元格复制到主表中答案

【问题标题】：VBA Loop Copy cells from worksheets into master sheetVBA循环将工作表中的单元格复制到主表中
【发布时间】：2020-02-06 13:26:41
【问题描述】：

我对 VBA 还很陌生，因此寻求帮助。

我有一个主工作表，我想整理从同一工作簿中的其他工作表收集的数据，工作表 2-60。我想将第一张表的单元格 A4 复制到单元格 B3 中，并将单元格 K7:K42 中的数据复制到单元格 B4:B41 中。然后移动到下一张表，将相同的数据范围插入 D3 和 D4:D41 列，依此类推，直到复制完所有表。

这是我目前所拥有的，但正如您所知，为 60 多张纸写出相同的两行代码将会非常冗长。

If myWs.Name <> "Master" Then

    If myWs.Name = "Sheet2" Then
    Sheets(myWs.Name).Range("K7:K42").Copy Destination:=Sheets("Master").Range("B4")
    Sheets(myWs.Name).Range("A4").Copy Destination:=Sheets("Master").Range("B3")
    End If

    If myWs.Name = "Sheet3" Then
    Sheets(myWs.Name).Range("K7:K42").Copy Destination:=Sheets("Master").Range("C4")
    Sheets(myWs.Name).Range("A4").Copy Destination:=Sheets("Master").Range("C3")
    End If

End If

Next

过去 2 天我确实搜索了 SO，并尝试了很多东西/代码，但到目前为止很短而且非常混乱。

【问题讨论】：

Wayne，有几点建议： 1) 要回复 cmets 中的人，您需要在他们的网名前加上 @ ； 2) 使用问题下方的edit 链接添加其他内容。它在评论中“丢失”并且无法格式化（在此处查看For Each...）

标签： excel vba loops copy

【解决方案1】：

试试这个代码：

Sub smth()

Dim myws As Worksheet, i As Long, ind As Long, col As Long

For Each myws In Worksheets

    If myws.Name <> "Master" Then

        ind = 0
        For i = Len(myws.Name) To 1 Step -1
            If IsNumeric(Mid(myws.Name, i, 1)) Then
                ind = i
            Else
                Exit For
            End If
        Next i
        If ind = 0 Then GoTo nextWS
        col = CLng(Mid(myws.Name, ind, Len(myws.Name) - ind + 1))

        myws.Range("A4").Copy Destination:=Sheets("Master").Cells(3, ind)
        myws.Range("K7:K42").Copy Destination:=Sheets("Master").Cells(4, ind)

    End If
nextWS:
Next

End Sub

此代码将检查您的工作表名称末尾是否有数字，如果是，它将使用该数字作为要粘贴到的列。

【讨论】：

谢谢你，上面的答案很完美，但我感谢你的意见。我也尝试了您的代码，它将第一张表粘贴到桅杆表中，然后用其他表覆盖此数据。有效地将所有数据放在主表中的相同单元格上。但我感谢您的宝贵时间。

【解决方案2】：

试试这个：

Option Explicit

Sub test()

    Dim wsMaster As Worksheet, ws As Worksheet
    Dim counter As Long

    counter = 2

    Set wsMaster = ThisWorkbook.Worksheets("Master")

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "Master" Then

            ws.Range("A4").Copy
            wsMaster.Cells(3, counter).PasteSpecial xlPasteValues

            ws.Range("K7:K42").Copy
            wsMaster.Cells(4, counter).PasteSpecial xlPasteValues

            counter = counter + 1

        End If

    Next ws

End Sub

【讨论】：