Question

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

我需要做什么：从多个工作表中复制列AS，这样行就会叠加在一起。这就是全部，没有公式只是文本。我修改了下面的代码，它可以工作，但我得到一个#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

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

1 个答案: