macros复制多个单元格区域并粘贴到另一个表单上

我logging了一个macros，我试图获得的是创build一个代码，将复制每个工作表上的代码中的以下范围，并将其粘贴在表“主”表中彼此下面的行中。

我有以下代码：

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 

Answer 2

这里有一个替代的“公式”方法

除了采用另一种方法之外，它还将从（nsheets-1）* ncell（按照tigeravatar的解决scheme）到（nsheets-1）+ ncell的迭代次数减less，是否应该是相关的问题

 Option Explicit Sub main() Dim ws As Worksheet Dim cell As Range, refCell As Range With ActiveWorkbook.Sheets("Master") For Each ws In wb.Sheets .Cells(.Rows.Count, 1).End(xlUp).Offset(1) = IIf(ws.Name <> .Name, ws.Name, "") Next ws Set refCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) For Each cell In 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") .Cells(refCell.Row, .Columns.Count).End(xlToLeft).Offset(, 1).Value = cell.Address ' set the reference for INDIRECT() function Next cell With .Range("B2", .Cells(refCell.Row, .Columns.Count).End(xlToLeft).Offset(-1)) .FormulaR1C1 = "=INDIRECT(ADDRESS(ROW(INDIRECT(R" & refCell.Row & "C)),COLUMN(INDIRECT(R" & refCell.Row & "C)),,,RC1))" .Value = .Value .Offset(.Rows.Count).Resize(1).ClearContents End With End With End Sub 

它将表格名称留在列“A”中：它们可以被移除