Excel VBA For-Next循环将数据从一个WB提取到另一个WB

时间:2016-05-26 19:21:46

标签: excel vba excel-vba for-loop

我正在开发一个for循环,根据第12列中的字符串等于“Airfare”提取整行数据。

想法是复制第12列(EXPENSE_TYPE)为Airfare的数据行,并将其粘贴到第二个工作簿中。

下面的代码未正确循环遍历所有120行数据。当我运行我的宏时,它只提取满足我的条件的第一行数据。如果您能找到我的问题,请告诉我。谢谢!

Sub exportDataToOtherWorkbook()
Dim lastRow As Long
Dim i As Long
Dim p As Integer
Dim q As Integer
Dim erow As Long

lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow
    If Cells(i, 12) = "Airfare" Then
    Range(Cells(i, 1), Cells(i, 16)).Select
    Selection.Copy


Workbooks.Open Filename:="C:\users\andrew.godish\Desktop\Practice Files\masterPracticeExtractDataWBtoWB.xlsx"

p = Worksheets.Count
    For q = 1 To p
        If ActiveWorkbook.Worksheets(q).Name = "Sheet2" Then
        Worksheets("Sheet2").Select
        End If
    Next q

    erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    ActiveSheet.Cells(erow, 1).Select
    ActiveSheet.Paste
    ActiveWorkbook.Save
    Application.CutCopyMode = False
    End If
Next i
End Sub

1 个答案:

答案 0 :(得分:2)

我建议循环遍历每一行。循环效率非常低,如果可能应该避免。

假设您的数据存储在" Sheet1" (要更改以满足您的要求)您正在复制的工作簿,您可以过滤第12列并使用更简单的命令复制所有数据,如下所示:

Sub Test()

        'Declare source and destination variables
        Dim sourceWB As Workbook, destWB As Workbook

        Set sourceWB = ThisWorkbook

        'Open the workbook to copy the data TO
        Workbooks.Open Filename:="C:\users\andrew.godish\Desktop\Practice Files\masterPracticeExtractDataWBtoWB.xlsx"
        Set destWB = ActiveWorkbook

        sourceWB.Sheets("Sheet1").Range("A1:P1").AutoFilter Field:=12, Criteria1:="Airfare"

        'The first offset on the copy is to avoid copying the headers each time, the second offset is to find the last row in the
        'list then offset to the next row. Copies data to new workbook
        sourceWB.Sheets("Sheet1").AutoFilter.Range.Offset(1).Copy Destination:=destWB.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)

        destWB.Save

        'Clear the filter from the source worksheet
        If sourceWB.Sheets("Sheet1").AutoFilterMode Then sourceWB.Sheets("Sheet1").ShowAllData

End Sub

我知道这并没有直接回答你的问题,但我认为这可能是一种更容易,更不容易出错的方法。

所以这个方法遵循以下步骤:

  • 打开目标工作簿
  • 在第12栏过滤Sheet1以获取" Airfare" (务必在必要时更改Sheet1
  • 将过滤后的范围复制并粘贴到目标工作表和工作簿
  • 删除应用于源工作表中第12列的过滤器

令人困惑的部分可能是Offset(1)的使用。我在副本上使用它以避免复制列标题(它将副本区域向下偏移一行)。我在目的地上使用它以避免覆盖最后一行(我们必须找到最后使用的行,然后向下递增一行)。