Question

我在合并工作表时找到了关于如何排除列标题的大量答案，但在复制初始工作表后我找不到关于如何排除A列的任何答案。请帮忙。警告：我对VBA很新，我可能做了些傻事，但我一直在努力让这项工作停留2天。我一直在结束if语句之前的最后两行代码中得到错误。我第一次发布一个问题，所以建议是否有更好的方法来做到这一点。

简单描述我想要的东西：

注意：所有工作表总共有365行，工作表数和列数不同。
选择第一张并将数据复制到新的“主”表，所有列和所有行
所有其他工作表将具有完全相同的A列，但需要将B通过未知数量的列并添加到主工作表中的下一个空白列。

示例：
表1有365行，只有A列和B列表2有365行，列A到D有数据新的主表单有365行，包含表1中的所有内容以及表2中的列B到H将作为列C到E添加到主表单

这是我的代码：

Dim ws As Worksheet
Dim wsMain As Worksheet
Dim DataRng As Range
Dim Col As Long
Dim Cnt As Integer

Application.DisplayAlerts = False
On Error Resume Next
Sheets("Report").Delete
Sheets("Wex").Delete
Sheets("C Locs").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add().Name = "Master"

Application.ScreenUpdating = False


Cnt = 1

Set wsMain = Worksheets("Master")
For Each ws In ThisWorkbook.Worksheets

If ws.Name <> wsMain.Name Then
If Cnt = 1 Then
Set DataRng = ws.Cells(1, 1).CurrentRegion
DataRng.Copy wsMain.Cells(1, Cnt)
Else: Col = wsMain.Cells(1, Columns.Count).End(xlToLeft).Column + 1

DataRng.Offset(0, 1).Resize(DataRng.Rows.Count, DataRng.Columns.Count - 1).Copy ActiveSheet.Cells(1, Col)

End If
End If
Cnt = Cnt + 1
Next ws



Application.ScreenUpdating = True

End Sub

Answer 1

For Each ws In ThisWorkbook.Worksheets

    If ws.Name <> wsMain.Name Then
        If Cnt = 1 Then
            Set DataRng = ws.Cells(1, 1).CurrentRegion
            DataRng.Copy wsMain.Cells(1, 1)
        Else
            With ws.Cells(1, 1).CurrentRegion
                Set DataRng = .Resize(.Rows.Count, .Columns.Count - 1).Offset(0, 1)
                DataRng.Copy wsMain.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
            End With
        End If

        Cnt = Cnt + 1
    End If

Next ws

Excel 2007 VBA将多个工作表合并为一个列偏移量

1 个答案: