我有多个工作表，它们的列数相同，但行数不同。我需要从每个工作表中以的形式复制列中的所有行，并将它们粘贴到新工作表中。当前列AS包含一个公式=X2
我需要做的是：从多个工作表中复制列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
试试这个：
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
