excel - 将所有工作表中的 A 列插入新工作表的 A 列

Question

我想将所有工作表的 A 列中的所有值堆叠到一个新工作表的 A 列中。这些列的长度取决于工作表。我之前成功地插入了列，但是它插入了公式而不是列的值，并且水平而不是垂直地插入了它们。

Sub Vlookpage()
Dim WS As Worksheet
Dim i As Integer

'add sheet and name it lookup
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Lookup"
'take all column "A"s and add them to "vlookup"
    For i = 1 To Worksheets.Count - 1
    Worksheets(i).Range("A:A").Copy
    Worksheets(i).Range("A:A").PasteSpecial Paste:=xlPasteValues
    Worksheets(i).Range("A:A").Copy
    Worksheets("Lookup").Range("A:A").Insert (xlShiftDown)
        Next i
'purge duplicates
    Worksheets("Lookup").Range("A:A").RemoveDuplicates
End Sub

列仍然水平插入而不是堆叠

标签： excelvba

Answer 1

请尝试下一个代码：

Sub Vlookpage()
 Dim WS As Worksheet, shLkp As Worksheet, i As Integer
 Dim lastRowL As Long, lastRowWs As Long, arrAA

   'add sheet and name it lookup
    Set shLkp = Sheets.Add(After:=Sheets(Sheets.count))
    shLkp.Name = "lookup"

   'take all column "A"s and add them to "vlookup"
    For Each WS In Worksheets
        If WS.Name <> shLkp.Name Then
            lastRowWs = WS.Range("A" & rows.count).End(xlUp).row
            lastRowL = shLkp.Range("A" & rows.count).End(xlUp).row
            arrAA = WS.Range("A1:A" & lastRowWs).Value

            shLkp.Range("A" & lastRowL + 1).Resize(UBound(arrAA), 1).Value = arrAA
        End If
    Next WS
   'purge duplicates
    shLkp.Range("A:A").RemoveDuplicates
End Sub