通过使用VBA将Excel列合并到一个工作表中

我有多个工作表，他们都有相同的列数，但不是相同的行数。 我需要从每个工作表中复制列AS所有行，并将它们彼此粘贴到一个新的工作表中。 当前列AS包含一个公式=X2 & " " & AL2 & "" ，它不允许我复制实际的“文本”并给我一个#ref! 错误。

我需要发生的事情：从多个工作表中复制列，以便行彼此堆叠。 这就是全部，没有公式只是文字。 我修改了下面的代码，它的工作原理，但我只是得到一个#ref! 错误。 我会很感激，如果有人可以帮助！

 Sub merge() Dim P As Integer On Error Resume Next Sheets(1).Select Worksheets.Add Sheets(1).Name = "Merged" Sheets(3).Activate Columns(45).Select Selection.Copy Destination:=Sheets(1).Range("A1") For P = 2 To Sheets.Count Sheets(P).Activate Range("A1").Select Selection.Columns(45).Select Selection.Copy Destination:=Sheets(1).Range("A1000000").End(xlUp)(2) Next End Sub Sub opensheets() Dim openfiles Dim x As Integer Dim selectversion As String selectversion = Worksheets("Settings").Range("C3").Value Dim ver As String If selectversion = "2003" Then ver = "xls" Else ver = "xlsx" End If On Error GoTo ErrHandler Application.ScreenUpdating = False openfiles = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*." & ver & "), *." & ver, MultiSelect:=True, Title:="Open Files") If TypeName(openfiles) = "Boolean" Then MsgBox "You need to select atleast one file" GoTo ExitHandler End If x = 1 While x <= UBound(openfiles) Workbooks.Open Filename:=openfiles(x) Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub 

Answer 1

尝试这个：

 Sub merge() Dim Sh As Worksheet, ShM As Worksheet, i&, z& Application.ScreenUpdating = 0 Set Sh = Worksheets.Add(, Sheets(Sheets.Count)) Sh.Name = "consolidated" For Each ShM In ThisWorkbook.Worksheets If ShM.Name <> Sh.Name Then i = ShM.Cells(Rows.Count, 45).End(xlUp).Row z = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 ShM.Activate: ShM.Range(Cells(1, 45), Cells(i, 45)).Copy Sh.Activate: Sh.Cells(z, 1).PasteSpecial xlPasteValues End If Next ShM Application.ScreenUpdating = 1 End Sub