Question

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

但是，范围可能包括我不想包含在数据中的空单元格，我还需要插入值（而不是粘贴），这样它们就不会覆盖已经在目的地表上的东西。 <{1}}而不是.Value或.Paste是首选。

希望这是有道理的

修改

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

.PasteSpecial

所以基本上它只需要找到数据并将其复制/插入目标表。

习惯于HTML和PHP，这对我来说是一个黑暗的跳跃：）

非常感谢大家

Answer 1

下面是您要查找的代码类型的示例。

但是，我建议在发布类似问题之前，再对VBA编程进行一些Google搜索。这将让您改进下面列出的代码。例如，Cells.SpecialCells(xlCellTypeLastCell).Row使用构建函数/方法来确定要复制的最后一行是什么;这可能是也可能不是你想要的。

此外，这个问题非常类似于Stack Overflow上的其他问题，例如： Copy range values one by one

然而，如果您希望使用下面的代码，只需将源工作表从“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 Environ Function

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

修改

2 个答案: