Question

如何将复制到合并工作表的数据粘贴为值，当前有效，但在存在公式的情况下，这些数据将被复制，实际上它需要从初始工作表中获取结果。

还需要一个额外的mod才能从每个条目表的第2行复制到统一数据选项卡。

Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet()

On Error GoTo IfError

Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

With Application
 .ScreenUpdating = False
 .EnableEvents = False
End With

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

With ActiveWorkbook
 Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
 DstSht.Name = "Consolidate_Data"
End With

For Each Sht In ActiveWorkbook.Worksheets

    If Sht.Name <> DstSht.Name Then

        DstRow = fn_LastRow(DstSht)     

        LstRow = fn_LastRow(Sht)
        LstCol = fn_LastColumn(Sht)
        EnRange = Sht.Cells(LstRow, LstCol).Address
        Set SrcRng = Sht.Range("A1:" & EnRange)

        If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
            MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
            GoTo IfError
        End If

        SrcRng.Copy Destination:=DstSht.Range("A" & DstRow + 1)

    End If

Next

DstSht.Range("A1") = "X"

IfError:
    With Application
     .ScreenUpdating = True
     .EnableEvents = True
    End With

End Sub

Function fn_LastRow(Sht As Worksheet)

Dim lastRow As Long
lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
lRow = Sht.Cells.SpecialCells(xlLastCell).Row
Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
    lRow = lRow - 1
Loop
fn_LastRow = lRow

End Function

Function fn_LastColumn(Sht As Worksheet)

Dim lastCol As Long
lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
lCol = Sht.Cells.SpecialCells(xlLastCell).Column
Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
    lCol = lCol - 1
Loop
fn_LastColumn = lCol

End Function

尝试添加：

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

合并特殊粘贴（值）

0 个答案: