vba - 复制多个单元格范围并粘贴到另一张工作表上的宏

Question

我录制了一个宏，我想要获得的是创建一个代码，该代码将在每个工作表的代码中复制以下范围，并将其粘贴在工作表“Master”上的行中。

我有以下代码:

Sub Macro1()
'
' Macro1 Macro
'

'
 Dim rng As Range
Sheets("AL-Jackson Hospital-Fvar").Select

Set rng = Range( _
"K50:M50,K58:M58,K59:M59,K55:M55,K12:M12,K14:M14,K24:L24,K28:L28,K29:L29,K35:L35,K62:L62,K32:L32,K30:L30,K31:L31,K63:L63,K33:L33,K34:L34,K37:L37,K40:L40,K41:L41,K42:L42,K46:L46" _
    )
rng.Select
Selection.Copy
Sheets("Master").Select
Range("B4").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst

End Sub

例如:
在工作表 1、2、3 上复制每个工作表上的以下范围并粘贴为从单元格 B1 开始的工作表 Master 中的值。所以表 1 的数据范围应该在 B1，表 2 的数据范围应该在 b2，表 3 的数据范围应该在 b3 等等......

伙计们，我的工作簿有 50 多张

Answer 1

类似的东西应该适合你:

Sub tgr()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsDest As Worksheet
    Dim rCell As Range
    Dim aData() As Variant
    Dim sCells As String
    Dim i As Long, j As Long

    Set wb = ActiveWorkbook
    Set wsDest = wb.Sheets("Master")
    sCells = "K50:M50,K58:M58,K59:M59,K55:M55,K12:M12,K14:M14,K24:L24,K28:L28,K29:L29,K35:L35,K62:L62,K32:L32,K30:L30,K31:L31,K63:L63,K33:L33,K34:L34,K37:L37,K40:L40,K41:L41,K42:L42,K46:L46"

    ReDim aData(1 To wb.Sheets.Count - 1, 1 To wsDest.Range(sCells).Cells.Count)

    i = 0
    For Each ws In wb.Sheets
        If ws.Name <> wsDest.Name Then
            i = i + 1
            j = 0
            For Each rCell In ws.Range(sCells).Cells
                j = j + 1
                aData(i, j) = rCell.Value
            Next rCell
        End If
    Next ws

    wsDest.Range("B1").Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData

End Sub