Копирование данных из двух рабочих листов в двух других рабочих листов поверх Чеха другой

Question

На этой картине,

вы видите, что я пытаюсь достичь, и что на самом деле происходит. Я смог определить, что данные переписывают данные, которые были помещены первыми. Что должно происходить мне нужно скопировать данные из:

1. MIM данных для MIM QA
2. БКРС Данные БКРСА QA
3. MIM данные для БКРСА QA (скопировано к следующей пустой строке)
4. BCRS Data to MIM QA (Скопировано в следующую пустую строку)

Это код, который я использую. Я попробовал несколько вариантов этого, не повезло. Я заимствовал этот код из другого листа, который делал что-то похожее, что означало получение новых данных и добавление их в следующую пустую строку.

Sub QA_Data_Copy_1603_A() 

Application.ScreenUpdating = False 

    Dim March_Swivel As Workbook ' Source Workbook 
     Set March_Swivel = Workbooks("Swivel - Master - March 2016.xlsm") 
    Dim MIM_Data As Worksheet ' Source Worksheet 
     Set MIM_Data = March_Swivel.Sheets("MIM Data") 
    Dim BCRS_Data As Worksheet ' Source Worksheet 
     Set BCRS_Data = March_Swivel.Sheets("BCRS Data") 
    Dim MIM_QA As Worksheet ' Destination Worksheet 
     Set MIM_QA = March_Swivel.Sheets("MIM QA") 
    Dim BCRS_QA As Worksheet ' Destination Worksheet 
     Set BCRS_QA = March_Swivel.Sheets("BCRS QA") 

    ' Source Rows 

    Dim MLastRow As Long 
     MLastRow = MIM_Data.Range("A" & Rows.Count).End(xlUp).row 
    Dim BLastRow As Long 
     BLastRow = BCRS_Data.Range("A" & Rows.Count).End(xlUp).row 

    ' Destination Rows 

    Dim MRow As Long 
     MRow = MIM_QA.Cells(Rows.Count, 1).End(xlUp).row 
    Dim BRow As Long 
     BRow = BCRS_QA.Cells(Rows.Count, 1).End(xlUp).row 


     MIM_Data.Range("A2:J" & MLastRow).Copy Destination:=MIM_QA.Range("A" & MRow + 1) 
     BCRS_Data.Range("A2:J" & BLastRow).Copy Destination:=BCRS_QA.Range("A" & BRow + 1) 
     MIM_Data.Range("A2:J" & MLastRow).Copy Destination:=BCRS_QA.Range("A" & BRow + 1) 
     BCRS_Data.Range("A2:J" & BLastRow).Copy Destination:=MIM_QA.Range("A" & MRow + 1) 

    Worksheets("BCRS Data").Columns("A:J").AutoFit 
    Worksheets("MIM Data").Columns("A:J").AutoFit 
    Worksheets("BCRS QA").Columns("A:J").AutoFit 
    Worksheets("MIM QA").Columns("A:J").AutoFit 

    Call QA_Color_Text 

    Application.ScreenUpdating = True 
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select 

End Sub 

Answer 1

Необходимо повторить пересчет последней строки перед перемещением данных во второй раз.

Некоторые изменения в коде ниже из-за того, как я создал свой тест, но вы можете увидеть перерасчета ...

Option Explicit 

Sub QA_Data_Copy_1603_A() 

Application.ScreenUpdating = False 

' Dim March_Swivel As Workbook ' Source Workbook 
'  Set March_Swivel = Workbooks("Swivel - Master - March 2016.xlsm") 
    Dim MIM_Data As Worksheet ' Source Worksheet 
     Set MIM_Data = Sheets("MIMData") 
    Dim BCRS_Data As Worksheet ' Source Worksheet 
     Set BCRS_Data = Sheets("BCRSData") 
    Dim MIM_QA As Worksheet ' Destination Worksheet 
     Set MIM_QA = Sheets("MIMQA") 
    Dim BCRS_QA As Worksheet ' Destination Worksheet 
     Set BCRS_QA = Sheets("BCRSQA") 

    ' Source Rows 

    Dim MIMDataLRow As Long 
     MIMDataLRow = MIM_Data.Range("A" & Rows.Count).End(xlUp).Row 
    Dim BCRSDataLRow As Long 
     BCRSDataLRow = BCRS_Data.Range("A" & Rows.Count).End(xlUp).Row 

    ' Destination Rows 

    Dim MIMQALRow As Long 
     MIMQALRow = MIM_QA.Cells(Rows.Count, 1).End(xlUp).Row 
    Dim BCRSQALRow As Long 
     BCRSQALRow = BCRS_QA.Cells(Rows.Count, 1).End(xlUp).Row 


     MIM_Data.Range("A2:J" & MIMDataLRow).Copy Destination:=MIM_QA.Range("A" & MIMQALRow + 1) 
     MIMQALRow = MIM_QA.Cells(Rows.Count, 1).End(xlUp).Row 
     BCRS_Data.Range("A2:J" & BCRSDataLRow).Copy Destination:=MIM_QA.Range("A" & MIMQALRow + 1) 

     BCRS_Data.Range("A2:J" & BCRSDataLRow).Copy Destination:=BCRS_QA.Range("A" & BCRSQALRow + 1) 
     BCRSQALRow = BCRS_QA.Cells(Rows.Count, 1).End(xlUp).Row 
     MIM_Data.Range("A2:J" & MIMDataLRow).Copy Destination:=BCRS_QA.Range("A" & BCRSQALRow + 1) 

' Worksheets("BCRS Data").Columns("A:J").AutoFit 
' Worksheets("MIM Data").Columns("A:J").AutoFit 
' Worksheets("BCRS QA").Columns("A:J").AutoFit 
' Worksheets("MIM QA").Columns("A:J").AutoFit 

' Call QA_Color_Text 

    Application.ScreenUpdating = True 
' Range("A" & Rows.Count).End(xlUp).Offset(1).Select 

End Sub