Excel 在所有当前和将来的图纸上复制相同的单元格，并粘贴到图纸1上

我有一本Excel工作簿，里面有很多工作表。每张表都标有月份和年份。i、 e.2019年1月，依此类推，第一页和第二页除外

第一张纸被隐藏（在那里什么也不做）。第二张表名为Sales Chart（我想在其中粘贴数据）。其余的是月表和年表

我需要复制所有当前月份和年份表上的单元格B5:B10，以及任何未来的表（将遵循月份和年份模式）。复制数据后，应水平粘贴（第一张图纸信息粘贴在B31行，第二张图纸信息粘贴在B32行，以此类推）

我正在使用我在网上找到的代码。它只复印一张纸。它复制公式，而不是公式结果。它垂直复制然后垂直粘贴，而不是垂直复制然后水平粘贴

子MakeSummaryTable（）
将ws设置为工作表
Application.ScreenUpdating=True
第（1）页。激活
对于工作表中的每个ws
如果ws.Name是“销售图表”，那么
ws.Range（“B5:B10”）。副本
活动页。粘贴范围（“B31”）。结束（xlUp）。偏移量（1，0）
如果结束
下一个ws
Application.ScreenUpdating=True
端接头

---

我希望代码从所有当前工作表中复制单元格B5:B10上的结果，并将其粘贴到工作表“Sales Chart”B31-G31（水平方向）和向下方向。

到目前为止，我的解决方案不确定检查月份是否正确的最佳方法

Sub PasteValuesFromMonthSheets()
    Dim wsChart As Worksheet
    On Error Resume Next
    Set wsChart = ThisWorkbook.Worksheets("Sales Chart")
    On Error GoTo 0
    If wsChart Is Nothing Then
        MsgBox "Cannot find Worksheet 'Sales Chart'.", vbOKOnly
        Exit Sub
    End If

    Dim wsSrc As Worksheet
    Dim lngRowOffset As Long

    For Each wsSrc In ThisWorkbook.Worksheets
        Dim arrSrcName As Variant
        arrSrcName = Split(wsSrc.Name, " ")
        If UBound(arrSrcName) = 1 Then
            If IsNumeric(arrSrcName(1)) Then
                Dim intMonth, intYear As Integer
                intMonth = MonthInt(arrSrcName(0))
                intYear = arrSrcName(1)
                If intMonth > 0 And intYear Like "####" Then
                    wsSrc.Range(wsSrc.Cells(5, 2), wsSrc.Cells(10, 2)).Copy
                    wsChart.Cells(lngRowOffset + 31, 2).PasteSpecial xlPasteValues, , , True
                    lngRowOffset = lngRowOffset + 1
                End If
            End If
        End If
    Next wsSrc

    Set wsChart = Nothing
End Sub

Private Function MonthInt(ByVal MonthString As String) As Integer
    Select Case MonthString
        Case "January"
            MonthInt = 1
        Case "February"
            MonthInt = 2
        Case "March"
            MonthInt = 3
        Case "April"
            MonthInt = 4
        Case "May"
            MonthInt = 5
        Case "June"
            MonthInt = 6
        Case "July"
            MonthInt = 7
        Case "August"
            MonthInt = 8
        Case "September"
            MonthInt = 9
        Case "October"
            MonthInt = 10
        Case "November"
            MonthInt = 11
        Case "December"
            MonthInt = 12
        Case Else
            MonthInt = -1
    End Select
End Function

---

我不太清楚您在这里想做什么：

范围（“B31”）。结束（xlUp）。偏移量（1，0）

但你可以试试这个：

Sub MakeSummaryTable()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets(1).Activate

For Each ws In Worksheets
    If ws.Name <> "Sales Chart" Then
        ws.Range("B5:B10").Copy
        If Range("B31").Value = "" Then
            Range("B31").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=True
        Else
            Range("B1048576").End(xlUp).Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=True
        End If
    End If
Next ws

Application.ScreenUpdating = True

End Sub

子MakeSummaryTable（）
将ws设置为工作表
Application.ScreenUpdating=False
第（1）页。激活
对于工作表中的每个ws
如果ws.Name是“销售图表”，那么
ws.Range（“B5:B10”）。副本
如果范围（“B31”）.Value=“”，则
范围（“B31”）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=真
其他的
范围（“B1048576”）。结束（xlUp）。偏移量（1，0）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=真
如果结束
如果结束
下一个ws
Application.ScreenUpdating=True
端接头

添加“PasteSpecial”以使用以下命令：

粘贴：=xlPasteValues

粘贴值而不是公式

转置：=真

水平粘贴“垂直”数据，反之亦然

最后，我用了这个：

范围（“B1048576”）。结束（xlUp）。偏移量（1，0）。选择

---

要获取B列中的最后一行（假设B:G列中最后一行和工作表末尾之间没有其他数据）

数据粘贴到销售图表工作表中的顺序是否重要？从第31行开始，宏是否应每次复制到销售图表单元格的顶部？如果我们将10行数据粘贴到销售图表中，但上次运行宏时已有20行数据，会发生什么情况？我希望将其水平粘贴以用于预测图表。宏不应该粘贴任何内容，除非它正在更新与其工作表对应的行。如果再次运行宏，它应该只更新新数据。我想它可以更新任何旧数据（应该保持不变，因为随着时间的推移，过去几个月的所有以前的数据都不应该改变。这是一个销售表，用来反映每月的业绩/销售额）。这正是我需要的，但它只复制了第一张和最后一张的信息。所以，在工作表（销售图表）上，我只有两行（确切地说是我想要的！！！）知道如何解决最后一个问题吗？没关系。在月份和年份之间有一个额外的空间来容纳那些没有填充的缺失月份。一旦我确定工作表选项卡的名称相同，一切都正常。谢谢你，罗伊。您的代码工作正常。@user11616229很高兴它能为您工作，很乐意提供帮助。此代码产生了“运行时错误1004应用程序定义或对象定义错误”