当工作簿vba之间复制大量行时出现问题

时间：2018-02-20 08:46:02

标签： vba excel-vba excel

我的代码正在解决的问题是，当我尝试复制大量行时，我的excel会被关闭（崩溃）。请帮忙。

Sub test()

Application.Calculation = xlCalculationManual

    Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook
    Dim MainBook As Workbook
    'Open All workbooks first:
    Set SourceData = ActiveWorkbook.Worksheets("SZCategoryData")
    Set TailoredData = ActiveWorkbook.Worksheets("SZCategory tailored")
    Set Wb1 = Workbooks.Open("D:\Userfiles\zbadah\Downloads\destination.xlsm")
 Application.ScreenUpdating = False
    Application.ScreenUpdating = False

    LastRow1 = SourceData.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    LastRow2 = TailoredData.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

    For i = 2 To 5000
        For j = 4 To 300



            If SourceData.Cells(i, 6).Value = "BRM_ID" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then

                     SourceData.Cells(i, 5).Cells.Copy
                     Wb1.Sheets("SZCategory tailored").Cells(j, 2).PasteSpecial

              ElseIf SourceData.Cells(i, 6).Value = "PCP TYPE" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 3).PasteSpecial

              ElseIf SourceData.Cells(i, 6).Value = "BRM REQ ID" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 4).PasteSpecial


              ElseIf SourceData.Cells(i, 6).Value = "1A WORKPACKAGE" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 6).PasteSpecial




               ElseIf SourceData.Cells(i, 6).Value = "PCP FLAG" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 13).PasteSpecial




                ElseIf SourceData.Cells(i, 6).Value = "PCP FLAG 2" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 7).PasteSpecial





             ElseIf SourceData.Cells(i, 6).Value = "UAT DROP" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 8).PasteSpecial



              ElseIf SourceData.Cells(i, 6).Value = "RELEASE" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then

                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 9).PasteSpecial




             ElseIf SourceData.Cells(i, 6).Value = "WN TYPE" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                     Wb1.Sheets("SZCategory tailored").Cells(j, 10).PasteSpecial



            ElseIf SourceData.Cells(i, 6).Value = "IMPACTED BY PCP" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 11).PasteSpecial


            ElseIf SourceData.Cells(i, 6).Value = "Baseline" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
                    SourceData.Cells(i, 5).Cells.Copy
                    Wb1.Sheets("SZCategory tailored").Cells(j, 12).PasteSpecial






            End If
            Next
        Next
    Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic


End Sub

1 个答案:

答案 0 :(得分：0)

我不太确定你是否会看到下面的代码有什么不同，但我想我会给它一个去，我也删除了所有的复制和粘贴，只是将值从一个单元格传递到另一个单元格：< / p> 

Sub test()
Dim Wb1 As Workbook
Dim ws1 As Worksheet, SourceData As Worksheet, TailoredData As Worksheet
Dim i as Long, j as Long
'Open All workbooks first:
Set SourceData = ThisWorkbook.Worksheets("SZCategoryData")
Set TailoredData = ThisWorkbook.Worksheets("SZCategory tailored")
Set Wb1 = Workbooks.Open("D:\Userfiles\zbadah\Downloads\destination.xlsm")
Set ws1 = Wb1.Worksheets("SZCategory tailored")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

'LastRow1 = SourceData.Cells(SourceData.Rows.Count, "A").End(xlUp).Row
''get the last row with data from SourceData Column A
'LastRow2 = TailoredData.Cells(TailoredData.Rows.Count, "A").End(xlUp).Row
''get the last row with data from TailoredData Column A

For i = 2 To 5000
    For j = 4 To 300
        If SourceData.Cells(i, 6).Value = "BRM_ID" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 2) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "PCP TYPE" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 3) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "BRM REQ ID" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 4) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "1A WORKPACKAGE" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 6) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "PCP FLAG" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 13) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "PCP FLAG 2" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 7) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "UAT DROP" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 8) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "RELEASE" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 9) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "WN TYPE" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 10) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "IMPACTED BY PCP" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 11) = SourceData.Cells(i, 5)
        ElseIf SourceData.Cells(i, 6).Value = "Baseline" And SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            ws1.Cells(j, 12) = SourceData.Cells(i, 5)
        End If
    Next j
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

<强>更新

使用Select Case代替If和ElseIF：

Sub test()
Dim Wb1 As Workbook
Dim ws1 As Worksheet, SourceData As Worksheet, TailoredData As Worksheet
Dim i As Long, j As Long
'Open All workbooks first:
Set SourceData = ThisWorkbook.Worksheets("SZCategoryData")
Set TailoredData = ThisWorkbook.Worksheets("SZCategory tailored")
Set Wb1 = Workbooks.Open("D:\Userfiles\zbadah\Downloads\destination.xlsm")
Set ws1 = Wb1.Worksheets("SZCategory tailored")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

LastRow1 = SourceData.Cells(SourceData.Rows.Count, "A").End(xlUp).Row
'get the last row with data from SourceData Column A
LastRow2 = TailoredData.Cells(TailoredData.Rows.Count, "A").End(xlUp).Row
'get the last row with data from TailoredData Column A

For i = 2 To LastRow1
    For j = 4 To LastRow2
        If SourceData.Cells(i, 1).Value = TailoredData.Cells(j, 1) Then
            Select Case SourceData.Cells(i, 6).Value
                Case "BRM_ID"
                    ws1.Cells(j, 2) = SourceData.Cells(i, 5)
                Case "PCP TYPE"
                    ws1.Cells(j, 3) = SourceData.Cells(i, 5)
                Case "BRM REQ ID"
                    ws1.Cells(j, 4) = SourceData.Cells(i, 5)
                Case "1A WORKPACKAGE"
                    ws1.Cells(j, 6) = SourceData.Cells(i, 5)
                Case "PCP FLAG"
                    ws1.Cells(j, 13) = SourceData.Cells(i, 5)
                Case "PCP FLAG 2"
                    ws1.Cells(j, 7) = SourceData.Cells(i, 5)
                Case "UAT DROP"
                    ws1.Cells(j, 8) = SourceData.Cells(i, 5)
                Case "RELEASE"
                    ws1.Cells(j, 9) = SourceData.Cells(i, 5)
                Case "WN TYPE"
                    ws1.Cells(j, 10) = SourceData.Cells(i, 5)
                Case "IMPACTED BY PCP"
                    ws1.Cells(j, 11) = SourceData.Cells(i, 5)
                Case "Baseline"
                    ws1.Cells(j, 12) = SourceData.Cells(i, 5)
            End Select
        End If
    Next j
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
相关问题
最新问题