在这张图片中,
你会看到我想要实现的目标以及实际发生的事情。我已经能够确定数据是否覆盖了首先放置的数据。应该发生什么是我需要复制数据:
这是我正在使用的代码。我尝试了几种不同的运气而没有运气。我从另一个做类似事情的工作表中借用了这个代码,意思是,获取新数据并将其添加到下一个空行。
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
答案 0 :(得分: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