使用VBA将值从一个表粘贴到另一个表

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了使用VBA将值从一个表粘贴到另一个表相关的知识,希望对你有一定的参考价值。

我有以下VBA代码,从Sheet Tabled数据中获取单行,复制数据,然后将数据粘贴到Sheet Running列表中的下一个可用行。但是原始行有公式,我需要粘贴值,而不是公式。我已经看到使用Range.PasteSpecial做了很多方法,但是这段代码没有使用Range,我不知道如何合并它。

注意:我从这里修改了这段代码:http://msdn.microsoft.com/en-us/library/office/ff837760(v=office.15).aspx。它最初有一个If语句来匹配单元格中的内容,然后根据单元格中的内容将其粘贴到某个表单中。我只有一张要复制的表,不需要IF。我真的不需要找到要复制的最后一行数据,因为它只会是一行,范围为A2:N2。但是如果我取出FinalRow部分和For并用Range替换(“A2:N2”),它就不起作用所以我把它们留在了。

任何有关如何添加PasteValues属性而不会使其更复杂的指导我真的很感激!我也愿意简化For或FinalRow变量,例如使用Range。我只是熟悉VBA,用它做了一些事情,但通常经过多次搜索和修改代码。谢谢!

Public Sub CopyData()
Sheets("Tabled data").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
 ' Loop through each row
For x = 2 To FinalRow
    ThisValue = Cells(x, 1).Value
    Cells(x, 1).Resize(1, 14).Copy
    Sheets("Running list").Select
    NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(NextRow, 1).Select
    ActiveSheet.Paste
    Sheets("Tabled data").Select
Next x

结束子

答案

希望我们能够让这更简单。

Public Sub CopyRows()
    Sheets("Sheet1").UsedRange.Copy
    lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    'check if the last cell found is empty
    If IsEmpty(ActiveSheet.Cells(lastrow, 1)) = True Then
        'if it is empty, then we should fill it
        nextrow = lastrow
    Else
        'if it is not empty, then we should not overwrite it
        nextrow = lastrow + 1
    End If

    ActiveSheet.Cells(nextrow, 1).Select
    ActiveSheet.Paste
End Sub

编辑:我扩展了一点,以便顶部不会有空行

另一答案

我找到了一个有效的解决方我录制了一个宏来获取特殊的粘贴,并添加了额外的代码来查找下一个空行:

Sub Save_Results()
' Save_Results Macro
  Sheets("Summary").Select 'renamed sheets for clarification, this was 'Tabled data'
'copy the row  
  Range("Table1[Dataset Name]").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Selection.Copy
' paste values into the next empty row
  Sheets("Assessment Results").Select
  Range("A2").Select
  NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
  Cells(NextRow, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
' Return to main sheet      
Sheets("Data Assessment Tool").Select
End Sub
另一答案

只需一次复制数据,无需一次连续执行。

Sub CopyData()

    With ThisWorkbook.Sheets("Tabled data")
        Dim sourceRange As Range
        Set sourceRange = .Range(.Cells(2, 1), .Cells(getLastRow(.Range("A1").Parent), 14))
    End With

    With ThisWorkbook.Sheets("Running list")
        Dim pasteRow As Long
        Dim pasteRange As Range
        pasteRow = getLastRow(.Range("A1").Parent) + 1
        Set pasteRange = .Range(.Cells(pasteRow, 1), .Cells(pasteRow + sourceRange.Rows.Count, 14))
    End With

    pasteRange.Value = sourceRange.Value

End Sub
Function getLastRow(ws As Worksheet, Optional colNum As Long = 1) As Long

    getLastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row

End Function
另一答案
Private Sub Load_Click()

    Call ImportInfo

End Sub

Sub ImportInfo()

    Dim FileName As String
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim ActiveListWB As Workbook
    Dim check As Integer

    'Application.ScreenUpdating = False
    Set WS2 = ActiveWorkbook.Sheets("KE_RAW")
        confirm = MsgBox("Select (.xlsx) Excel file for Data transfer." & vbNewLine & "Please ensure the sheets are named Sort List, Second and Third.", vbOKCancel)

    If confirm = 1 Then
        FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
                Title:="Select Active List to Import", MultiSelect:=False)

        If FileName = "False" Then
                MsgBox "Import procedure was canceled"
                Exit Sub
            Else
                Call CleanRaw
                Set ActiveListWB = Workbooks.Open(FileName)
        End If

        Set WS1 = ActiveListWB.Sheets("Sort List")
        WS1.UsedRange.Copy 'WS2.Range("A1")
       ' WS2.Range("A1").Select
        WS2.UsedRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'WS2.Range ("A1")
        ActiveWorkbook.Close False

     'Call ClearFormulas

       ' Call RefreshAllPivotTables

        Sheets("Key Entry Data").Select
        'Sheets("Raw").Visible = False
        'Application.ScreenUpdating = True
        MsgBox "Data has been imported to workbook"

    Else
        MsgBox "Import procedure was canceled"
    End If

        Application.ScreenUpdating = True

End Sub

Sub CleanRaw()

    Sheets("KE_RAW").Visible = True
    Sheets("KE_RAW").Activate
    ActiveSheet.Cells.Select
    Selection.ClearContents

End Sub

以上是关于使用VBA将值从一个表粘贴到另一个表的主要内容,如果未能解决你的问题,请参考以下文章

根据查找值将值从一张表匹配并粘贴到另一张表中

VBA代码将值从一个单元格复制到特定列

在vba中粘贴特殊

VBA使用自动筛选器将值复制到另一个工作表

如何将值从一个片段的回收器视图项传递到另一个片段

根据 postgresQL 中的时间戳将值从一个表映射到另一个表