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

时间:2015-06-23 06:39:44

标签: excel vba excel-vba

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

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

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

1 个答案:

答案 0 :(得分:0)

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

您是否一步一步地尝试了代码(例如,通过在某些关键位置插入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