Excel 疑难解答：在VBA中将多张图纸中的数据复制到一张图纸中

我有下面的代码，目前可以工作，但没有显示我想要的方式。我是VBA新手，所以我从web上使用了此模板

它制作了一张名为“归档”的表格，然后将我在其他40张表格中的所有数据打印到上面。问题是它从上到下读取

Public Sub m()
    Dim lRow As Long
    Dim sh As Worksheet
    Dim shArc As Worksheet
    Set shArc = ThisWorkbook.Worksheets("Archive")
    For Each sh In ThisWorkbook.Worksheets
        Select Case sh.Name
            Case Is <> "Archive"
                lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row
                sh.Range("B1:M247").Copy 
                _Destination:=shArc.Range("A" & lRow)
        End Select
    Next
    Set shArc = Nothing
    Set sh = Nothing
End Sub

Public Sub m（）
暗淡的光线和长的一样
将sh设置为工作表
Dim shArc As工作表
Set shArc=thishworkbook.Worksheets（“存档”）
用于此工作簿中的每个sh。工作表
选择案例名称
案例是“档案”
lRow=shArc.Range（“A”&Rows.Count）.End（xlUp）.Row
sh.Range（“B1:M247”）。副本
_目的地：=shArc.Range（“A”&lRow）
结束选择
下一个
设置shArc=Nothing
设置sh=无
端接头

我希望宏粘贴数据，以便从左向右读取

---

TLDR：代码收集数据，但垂直粘贴所有数据。我希望它水平粘贴。有人能修改它吗？

所以我尝试了更多的修改，并编辑了之前的一个回复。这似乎对我目前的目的起了作用

Public Sub m()
    Dim lCol As Long
    Dim sh As Worksheet
    Dim shArc As Worksheet
    Set shArc = ThisWorkbook.Worksheets("Archive")
    For Each sh In ThisWorkbook.Worksheets
        Select Case sh.Name
             'do nothing
        Case Else
            lCol = shArc.Cells(1, shArc.Columns.Count).End(xlToLeft).Column
            sh.Range("B1:M247").Copy _
              Destination:=shArc.Cells(1, lCol + 13)
    End Select
Next
    Set shArc = Nothing
    Set sh = Nothing
End Sub

---

我建议进行编辑，删除

，并添加代码格式，以使您的文章更具可读性。请仔细检查我是否无意中删除了这两行的一个字符：

sh.Range（“B1:M247”）。如果需要，请复制
和
\u Destination:=shArc.Range（“a”&lRow）
正确。因此，我尝试用这里的一个回复编辑代码-它的方向正确，但它只占用了每张纸的第一列。不过，每一页我都有13栏，我只是想编辑一下，让问题更具可读性。希望确保我没有在代码块中添加错误。