Excel宏插入另一个工作簿中的数据

Question

有人可以帮助我执行以下操作：我需要将一系列单元格复制（或使用类似的VBA函数）到另一个工作表。

但是，该范围可能包含我不想包含在数据中的空单元格，并且我还需要插入值（而不是粘贴），以便它们不会覆盖目标工作表中已有的内容。 .Value而非.Paste或.PasteSpecial是优选的。

希望这有意义

---

编辑

这是我尝试过的一些代码，但这仍然会覆盖目标工作表中的数据（即使所选单元格为空）。

Sub MakeQuote()
Application.ScreenUpdating = False
  Sheets("Code Input Sheet").Range("A9:C800").Copy
  Workbooks.Open("C:\Users\j\Documents\Trial.xltm").Activate
  Sheets("Special Quote").Range("A4").PasteSpecial xlPasteValues, skipBlanks:=False
  Application.CutCopyMode = False
Err_Execute:
    If Err.Number = 0 Then MsgBox "Copying Successful :)" Else _
    MsgBox Err.Description
    Application.ScreenUpdating = True
End Sub

因此，基本上它只需要查找数据并将其复制/插入到目标表中即可。

对于HTML和PHP来说，这对我来说是个飞跃：)

非常感谢大家

Answer 1

您在寻找什么样的代码示例如下。

但是，我建议在发布类似问题之前再对VBA编程进行一些Google搜索。 这可以让您改进下面列出的代码。 例如， Cells.SpecialCells(xlCellTypeLastCell).Row使用内置函数/方法来找出您要复制的最后一行； 可能不是您要找的东西。

此外，此问题与“堆栈溢出”中的其他问题高度相似，例如： 逐一复制范围值

但是，如果您希望使用下面的代码，只需将源工作表从“ Sheet1”更改为源数据来自哪个工作表，并将源范围从“ C1”更改为您正在使用的工作表中的任何范围。 同样，您将需要处理目标。

Sub rangeCopy()
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim lastRow As Long
    Dim sourceCounter As Long
    Dim targetCounter As Long
    Dim outString As String

    'Change the source and target sheet as needed.
    Set sourceRange = Sheets("Sheet1").Range("C1")
    Set targetRange = Sheets("Sheet2").Range("A1")

    lastRow = sourceRange.Parent.Cells.SpecialCells(xlCellTypeLastCell).Row

    For sourceCounter = 0 To lastRow - 1

        'Copy the cell you want to transfer from the source apge
        outString = Trim(sourceRange.Offset(sourceCounter).Value)

        'Find the next empty cell in the target worksheet
        While (Trim(targetRange.Offset(targetCounter).Value) <> "")
            targetCounter = targetCounter + 1
        Wend

        targetRange.Offset(targetCounter).Value = outString
    Next

End Sub

更新的代码

此代码已更新，以匹配包含多个单元格的输入源范围。

sub rangeCopy()
    Dim sourceRange As Range, loopRange As Range
    Dim targetRange As Range
    Dim lastRow As Long
    Dim sourceCounter As Long
    Dim targetCounter As Long
    Dim outString As String
    Dim startRow As Long
    Dim startCol As Long
    Dim endCol As Long
    Dim colCounter As Long

    'Change the source and target sheet as needed.
    Set sourceRange = Sheets("Sheet1").Range("B2:C34")
    Set targetRange = Sheets("Sheet2").Range("A1")

    startRow = sourceRange.Row
    lastRow = sourceRange.Rows.Count
    startCol = sourceRange.Column
    endCol = sourceRange.Columns.Count - 1
    Set loopRange = sourceRange.Parent.Cells(startRow, startCol)


    For colCounter = 0 To endCol
        targetCounter = 0
        For sourceCounter = 0 To lastRow - 1

            'Copy the cell you want to transfer from the source apge
            outString = Trim(loopRange.Offset(sourceCounter, colCounter).Value)

            'Find the next empty cell in the target worksheet
            While (Trim(targetRange.Offset(targetCounter, colCounter).Value) <> "")
                targetCounter = targetCounter + 1
            Wend

            targetRange.Offset(targetCounter, colCounter).Value = outString
        Next
    Next

End Sub

Answer 2

简单值到范围内的值

例

Option Explicit
'// Value to Value
Sub Value_To_Value()

    Dim FilePath As String

    '// Workbook1 File Path
    FilePath = Environ("USERPROFILE") & "\Documents\Temp\" '<- Change Path

    With Range("A1:A10")
        .Value = "='" & FilePath & "[Workbook1.xlsm]Sheet1'!B1:B10"
    End With

End Sub

MSDN 环境功能