无法从vba中的另一个Excel文件复制多行

Question

我正在编写一个宏，它从一个文件夹中的多个文件进行复制并粘贴到另一个工作表上，我从中提取数据的文件如下所示：

我的代码应该从第4行开始从列B和C中提取值，直到它到达B列中的空白单元格。但事实证明只复制第五行值：

A列中的值是文件名（CH57197），然后将IP地址和主机名复制到B和C列，如上面的屏幕截图所示。

我从文件中提取值的代码如下：

repaint

粘贴指定位置的代码：

 With mybook.Worksheets(1)

                'Set sourceRange = .Range("A1:B2")
                ' Change Range if B1 value is "Host Name"
                celltxt = .Range("B1").Value
                If InStr(1, celltxt, "Host") Then

                    '// Here lets Find the last row of data
                    wSlastRow = Application.WorksheetFunction.CountIf(Range("B:B"), "*")
                    'wSlastRow = .Rows(.Rows.Count).End(xlUp).Row

                    '// Now Loop through each row
                    For X = 4 To wSlastRow
                        Set sourceRange = Union(Range("B" & X), Range("C" & X))
                        'Set sourceRange = .Union(Range("B" & (X)), Range("C" & (X)))

                    Next X
                ElseIf InStr(1, .Range("B2").Value, "Hostname") Then

                    '// Here lets Find the last row of data
                    wSlastRow = Application.WorksheetFunction.CountIf(Range("B:B"), "*")
                    'wSlastRow = .Rows(.Rows.Count).End(xlUp).Row

                    '// Now Loop through each row
                    For X = 3 To wSlastRow
                        Set sourceRange = Union(Range("B" & X), Range("C" & X))
                        'Set sourceRange = .Union(Range("B" & (X)), Range("C" & (X)))

                    Next X


                End If
            End With

Answer 1

在这样的宏中，我总觉得使用简单的变量来跟踪你在表格中的位置，可以使代码更清晰，更难以犯错误。

您是否一步一步地尝试了代码（例如，通过在某些关键位置插入MsgBox来查看沿途发生了什么）？我不是100％肯定，但我怀疑你可能会复制到同一个地方，所以第4行被复制，但是当第5行被复制时会被删除。当您在第4-7行中的数据上测试宏时，它返回5-7行还是仅返回第7行？

无论如何，下面的代码应该做你似乎遇到麻烦的主要事情。为了清楚起见，你必须调整一点并添加我省略的部分（主要是If Then条款，这些条款似乎可以测试某些内容，并且你对它们的执行方式感到满意。）

With mybook.Worksheets(1)

    Dim readrow As Integer
    Dim writerow As Integer

    'This looks for first free row in the write worksheet
    writerow = 1
    Do Until writebook.Worksheets(2).Range("A" & writerow).Value = ""
        writerow = writerow + 1
    Loop

    'Loop through rows copying the data
    readrow = 4
    Do Until .Range("B" & readrow).Value = ""
        writebook.Worksheets(2).Range("A" & writerow).Value = file_name
        'file_name variable should contain the name of the file you want to put in column A
        .Range("B" & readrow & ":C" & readrow).Copy Destination:=writebook.Worksheets(2).Range("B" & writerow)
        writerow = writerow + 1
        readrow = readrow + 1
    Loop

End With