遍历列并将值粘贴到现有工作簿答案

【问题标题】：Loop throug column and paste values to an existing workbook遍历列并将值粘贴到现有工作簿
【发布时间】：2019-04-03 20:23:38
【问题描述】：

嗨，这是我的第一篇文章，我是 VBA 的新手。所以我尝试了最后 6 个小时来完成一项任务。

我已经设法获取 For each 循环的代码，它可以工作并将值复制到现有工作簿。但我不知道为什么它总是将值复制到 A2 而不是进一步复制到 A3/A4/A5 等等。

我尝试了这些代码“ range = range + 1 ”，但我不断收到运行时错误，它仍然将值复制到 A2 并在从循环中获取新值时覆盖它。

我认为它只需要一点点改变，但我无法弄清楚。 :(

Sub copie1()

Dim ws As Worksheet
Dim cell As Range
Dim targetsheet As Worksheet
Dim target As Range
Dim rngTemp As Range

Set wkba = ActiveWorkbook

Worksheets("cop1").Activate
LR = Cells(Rows.Count, "A").End(xlUp).Row
LT = Cells(Rows.Count, "X").End(xlUp).Row

    Set rngTemp = Range("X2:X" & LT)

   Workbooks.Open Filename:="C:\Users\path......."
        Set targetsheet = Worksheets("Data")
     Set target= targetsheet.Range("A1")

For Each cell In rngTemp
If cell > 0 Then

target.Offset(1, 0) = cell.Value

        End If


      target = target+1  '// is this right? 

Next cell





End Sub

我的目标是遍历工作簿中的 X 列并复制大于 0 的每个数据（因为有空单元格和值为 0 的单元格）并将其粘贴到 A2/A3/A4 等范围内的现有工作簿中

【问题讨论】：

target = target + 1 隐含地在做target.Value = target.Value + 1，如果这就是你的意思，这是正确的。是吗？
使用计数器。 counter = 1 If cell.Value > 0 Then targetSheet.Range("A" & counter).Value = cell.Value counter = counter + 1 End If
我使用了一个计数器，现在它复制了所有值但它跳过了单元格？例如 A2 被填充，然后是空白单元格直到 A21 和一堆复制的值，然后是空白单元格？
@SibSib1903，我提供了一个例子来帮助你。

标签： excel vba loops copy-paste

【解决方案1】：

您不能将数字一添加到 Range 对象中。

尝试将target = target+1 '// is this right? 替换为：

Set target = target.Offset(1)

这能解决问题吗？

【讨论】：

看起来我需要一个计数器这个解决方案导致运行时错误
哪一行抛出错误？或者是否有任何错误详情？你并不特别需要一个柜台，我不认为。 For Each cell in rngTemp 应该限制您搜索的范围。

【解决方案2】：

SibSib1903，我在下面添加了一个简单的示例，您可以轻松地适应自己的要求。它会查看 A 列中的所有单元格值，并且任何大于零的数值都会从第 1 行开始复制到 C 列。例如，如果 A 列包含 45 行数据，而其中只有 3 行的数值大于零，这三个值将复制到前三行的 C 列中。

Public Sub copieTest()
Dim ws As Worksheet, cell As Range, rngX As Range
Dim tmpVal As Variant, counter As Long

Set ws = ThisWorkbook.Worksheets("cop1")
Set rngX = ws.Range("A1:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)

counter = 1
For Each cell In rngX
    tmpVal = Val(Trim(cell.Value))
    If tmpVal > 0 Then
        ws.Range("C" & counter).Value = tmpVal
        counter = counter + 1
    End If
Next cell
Set rngX = Nothing: Set ws = Nothing

End Sub

【讨论】：