Question

我需要从+10张纸上的F列复制所有文本值，并将它们放在汇总表上的单个Column中。我不需要对数据进行任何计算，只需复制从公式得出的文本值即可。例如：

Sheet1 Col F：

1

2

3

Sheet2 Col F：

4

5

6

我希望“大师” A上校是：

1

2

3

...

6

这段代码使我几乎可以到达那里，但是我需要Range来改变。例如，并不是每张纸都有3行数据，但是我希望它们彼此直接直接复制。

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        ws.Range("F1:G15").Copy 
        Sheets("Master").Range("A" & lr).PasteSpecial xlPasteValues
        lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next ws
End Sub

编辑：每个工作表的行数都相同，但其中包含公式，但是值在工作表之间是不同的。因此，我需要进行一些检查，以寻找“”值作为“最后一行”，然后移至下一页。

Answer 1

只有很小的变化，并且效果很好：) 1.我将 Master更改为Sheet5 =>您可以使用工作表名称。
2.在循环中添加了新变量，以标识要复制的每张图纸的范围。
3.更改方法以将复制的数据粘贴到目标位置。

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each ws In Worksheets
    If ws.Name <> "Sheet5" Then
        Dim currentRange As Long
        currentRange = ws.Cells(Rows.Count, "A").End(xlUp).Row
        ws.Range("A1:A" & currentRange).Copy Destination:=Sheets("Sheet5").Range("A" & lr)
        lr = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next ws
End Sub

让我知道这是否对您有用吗？

Answer 2

首先，您可以使用相同的逻辑来获取每个数据表中“ F”列的最后一行，而不是使用range.end(xlUp).Row方法对3行进行硬编码。

2nd我不喜欢复制粘贴方法。它很慢，很麻烦，您总是在计算新的插入点并粘贴。您可以在VBA中利用阵列来实现此功能。而且使用Array的工作非常简单快捷。

下面是您可以获取和使用的代码。

Sub MM1()
Application.ScreenUpdating = False
'Loop through worksheets, put the values in column F into arr array
Dim arr(1 To 10000), cnt As Integer, i As Integer
cnt = 0
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        For i = 1 To ws.Cells(Rows.Count, "F").End(xlUp).Row
            cnt = cnt + 1
            arr(cnt) = ws.Cells(i, "F").Value
        Next i
    End If
Next ws

'Loop through arr array, populate value into Master sheet, column A
For i = 1 To cnt
    ThisWorkbook.Sheets("Master").Cells(i, "A") = arr(i)
Next i

Application.ScreenUpdating = True
End Sub

Answer 3

我试图保持您的代码尽可能完整。这是使其工作的一种方法（尽可能保留更多代码）。您仍然需要做一些“修饰”（例如，“主”页面上会有空白行）。

Sub MM1()
Dim ws As Worksheet
For Each ws In Worksheets
     If ws.Name <> "Master" Then
         ws.Range(ws.Range("F1"), ws.Range("F1").End(xlDown)).Copy
         Sheets("Master").Range("A65535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
     End If
Next ws
End Sub

VBA excel-将多个工作表中的列合并为另一工作表中的单个列

3 个答案: