Excel 2007 VBA：如何从一张纸上的动态范围复制并粘贴到另一张纸的第一个空行？

Question

我的问题与此处回答的问题类似（https://stackoverflow.com/a/17071905/2506351），只是我需要将数据粘贴到其他工作表的第一个空行。我试过使用lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1，但那不起作用。下面是我的完整代码的副本至今......

Option Explicit 

Private Sub SortAndMove_Click() 
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 

Dim lngLastRow As Long 
Dim COMSheet As Worksheet, COMROLLSheet As Worksheet, CFUSheet As Worksheet, EPS2Sheet  As Worksheet, EPS3Sheet As Worksheet, ER1Sheet As Worksheet, ER2Sheet As Worksheet, FIPSheet As Worksheet, HDWSheet As Worksheet, RPS2Sheet As Worksheet, RPS3Sheet As Worksheet, RPS4Sheet As Worksheet, RR4Sheet As Worksheet, SCHSheet As Worksheet, SCHROLLSheet As Worksheet, TACSheet As Worksheet, TARSheet As Worksheet, TR1Sheet As Worksheet, TR2Sheet As Worksheet, WINSheet As Worksheet, WIN2Sheet As Worksheet, WIN3Sheet As Worksheet 

Set COMSheet = Sheets("COM Data") 
Set COMROLLSheet = Sheets("COM ROLL Data") 
Set CFUSheet = Sheets("CFU Data") 
Set EPS2Sheet = Sheets("EPS2 Data") 
Set EPS3Sheet = Sheets("EPS3 Data") 
Set ER1Sheet = Sheets("ER1 Data") 
Set ER2Sheet = Sheets("ER2 Data") 
Set FIPSheet = Sheets("FIP Data") 
Set HDWSheet = Sheets("HDW Data") 
Set RPS2Sheet = Sheets("RPS2 Data") 
Set RPS3Sheet = Sheets("RPS3 Data") 
Set RPS4Sheet = Sheets("RPS4 Data") 
Set RR4Sheet = Sheets("RR4 Data") 
Set SCHSheet = Sheets("SCH Data") 
Set SCHROLLSheet = Sheets("SCH ROLL Data") 
Set TACSheet = Sheets("TAC Data") 
Set TARSheet = Sheets("TAR Data") 
Set TR1Sheet = Sheets("TR1 Data") 
Set TR2Sheet = Sheets("TR2 Data") 
Set WINSheet = Sheets("WIN Data") 
Set WIN2Sheet = Sheets("WIN2 Data") 
Set WIN3Sheet = Sheets("WIN3 Data") 

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 

With Range("A5", "O" & lngLastRow) 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="COM" 
    .Copy COMSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="COR" 
    .Copy COMROLLSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="CF1" 
    .Copy CFUSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="EP2" 
    .Copy EPS2Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="EP3" 
    .Copy EPS3Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="ER1" 
    .Copy ER1Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="ER2" 
    .Copy ER2Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="FIP" 
    .Copy FIPSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="HDW" 
    .Copy HDWSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="RP2" 
    .Copy RPS2Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="RP3" 
    .Copy RPS3Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="RP4" 
    .Copy RPS4Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="RR4" 
    .Copy RR4Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="CH1" 
    .Copy SCHSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="CR1" 
    .Copy SCHROLLSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="TAC" 
    .Copy TACSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="TAR" 
    .Copy TARSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="TR1" 
    .Copy TR1Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="TR2" 
    .Copy TR2Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="WIN" 
    .Copy WINSheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="W2" 
    .Copy WIN2Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 
    .AutoFilter Field:=1, Criteria1:="W3" 
    .Copy WIN3Sheet.Range("B" & .Rows.Count).End(xlUp).Row + 1 
    .AutoFilter 

End With 

Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 
End Sub 

与头部的餐饮太大的帮助，我想出了以下为我的最终代码：

Option Explicit 

Private Sub Transfer_Click() 
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 

Dim src As Worksheet 
Dim lngLastRow As Long 
Dim tgtCom As Worksheet 
Dim tgtLRCom As Long 
Dim tgtComRoll As Worksheet 
Dim tgtLRComRoll As Long 
Dim tgtCFU As Worksheet 
Dim tgtLRCFU As Long 
Dim tgtEPS2 As Worksheet 
Dim tgtLREPS2 As Long 
Dim tgtEPS3 As Worksheet 
Dim tgtLREPS3 As Long 
Dim tgtER1 As Worksheet 
Dim tgtLRER1 As Long 
Dim tgtER2 As Worksheet 
Dim tgtLRER2 As Long 
Dim tgtFIP As Worksheet 
Dim tgtLRFIP As Long 
Dim tgtHDW As Worksheet 
Dim tgtLRHDW As Long 
Dim tgtRPS2 As Worksheet 
Dim tgtLRRPS2 As Long 
Dim tgtRPS3 As Worksheet 
Dim tgtLRRPS3 As Long 
Dim tgtRPS4 As Worksheet 
Dim tgtLRRPS4 As Long 
Dim tgtRR4 As Worksheet 
Dim tgtLRRR4 As Long 
Dim tgtSCH As Worksheet 
Dim tgtLRSCH As Long 
Dim tgtSCHROLL As Worksheet 
Dim tgtLRSCHROLL As Long 
Dim tgtTAC As Worksheet 
Dim tgtLRTAC As Long 
Dim tgtTAR As Worksheet 
Dim tgtLRTAR As Long 
Dim tgtTR1 As Worksheet 
Dim tgtLRTR1 As Long 
Dim tgtTR2 As Worksheet 
Dim tgtLRTR2 As Long 
Dim tgtWIN As Worksheet 
Dim tgtLRWIN As Long 
Dim tgtWIN2 As Worksheet 
Dim tgtLRWIN2 As Long 
Dim tgtWIN3 As Worksheet 
Dim tgtLRWIn3 As Long 

Set wb = ThisWorkbook 
Set src = wb.Sheets("Transfer") 
Set tgtCom = wb.Sheets("COM Data ") 
Set tgtComRoll = wb.Sheets("COM ROLL Data") 
Set tgtCFU = wb.Sheets("CFU Data") 
Set tgtEPS2 = wb.Sheets("EPS2 Data") 
Set tgtEPS3 = wb.Sheets("EPS3 Data") 
Set tgtER1 = wb.Sheets("ER1 Data") 
Set tgtER2 = wb.Sheets("ER2 Data") 
Set tgtFIP = wb.Sheets("FIP Data") 
Set tgtHDW = wb.Sheets("HDW Data") 
Set tgtRPS2 = wb.Sheets("RPS2 Data") 
Set tgtRPS3 = wb.Sheets("RPS3 Data") 
Set tgtRPS4 = wb.Sheets("RPS4 Data") 
Set tgtRR4 = wb.Sheets("RR4 Data") 
Set tgtSCH = wb.Sheets("SCH Data") 
Set tgtSCHROLL = wb.Sheets("SCH ROLL Data") 
Set tgtTAC = wb.Sheets("TAC Data") 
Set tgtTAR = wb.Sheets("TAR Data") 
Set tgtTR1 = wb.Sheets("TR1 Data") 
Set tgtTR2 = wb.Sheets("TR2 Data") 
Set tgtWIN = wb.Sheets("WIN Data") 
Set tgtWIN2 = wb.Sheets("WIN2 Data") 
Set tgtWIN3 = wb.Sheets("WIN3 Data") 

lngLastRow = Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRCom = tgtCom.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRComRoll = tgtComRoll.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRCFU = tgtCFU.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLREPS2 = tgtEPS2.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLREPS3 = tgtEPS3.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRER1 = tgtER1.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRER2 = tgtER2.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRFIP = tgtFIP.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRHDW = tgtHDW.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRRPS2 = tgtRPS2.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRRPS3 = tgtRPS3.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRRPS4 = tgtRPS4.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRRR4 = tgtRR4.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRSCH = tgtSCH.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRSCHROLL = tgtSCHROLL.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRTAC = tgtTAC.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRTAR = tgtTAR.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRTR1 = tgtTR1.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRTR2 = tgtTR2.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRWIN = tgtWIN.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRWIN2 = tgtWIN2.Cells(Rows.Count, "B").End(xlUp).Row + 1 
tgtLRWIn3 = tgtWIN3.Cells(Rows.Count, "B").End(xlUp).Row + 1 

With src.Range("A4", "O" & lngLastRow) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="COM" 
.Copy tgtCom.Range("B" & tgtLRCom) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="COR" 
.Copy tgtComRoll.Range("B" & tgtLRComRoll) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="CF1" 
.Copy tgtCFU.Range("B" & tgtLRCFU) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="EP2" 
.Copy tgtEPS2.Range("B" & tgtLREPS2) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="EP3" 
.Copy tgtEPS3.Range("B" & tgtLREPS3) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="ER1" 
.Copy tgtER1.Range("B" & tgtLRER1) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="ER2" 
.Copy tgtER2.Range("B" & tgtLRER2) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="FIP" 
.Copy tgtFIP.Range("B" & tgtLRFIP) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="HDW" 
.Copy tgtHDW.Range("B" & tgtLRHDW) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="RPS2" 
.Copy tgtRPS2.Range("B" & tgtLRRPS2) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="RP3" 
.Copy tgtRPS3.Range("B" & tgtLRRPS3) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="RP4" 
.Copy tgtRPS4.Range("B" & tgtLRRPS4) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="RR4" 
.Copy tgtRR4.Range("B" & tgtLRRR4) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="CH1" 
.Copy tgtSCH.Range("B" & tgtLRSCH) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="CR1" 
.Copy tgtSCHROLL.Range("B" & tgtLRSCHROLL) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="TAC" 
.Copy tgtTAC.Range("B" & tgtLRTAC) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="TAR" 
.Copy tgtTAR.Range("B" & tgtLRTAR) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="TR1" 
.Copy tgtTR1.Range("B" & tgtLRTR1) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="TR2" 
.Copy tgtTR2.Range("B" & tgtLRTR2) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="WIN" 
.Copy tgtWIN.Range("B" & tgtLRWIN) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="W2" 
.Copy tgtWIN2.Range("B" & tgtLRWIN2) 
.AutoFilter 
.AutoFilter Field:=1, Criteria1:="W3" 
.Copy tgtWIN3.Range("B" & tgtLRWIn3) 
.AutoFilter 

End With 

Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 

End Sub 

Answer 1

您需要找到目标工作表上的最后一个空行，而不是activesheet。

更改此：

lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 

这样：

dim tgt as Worksheet 
' specify the sheet you want to paste into here 
set tgt = Sheets("COM Data") 
lastRow = tgt.Cells(Rows.Count, "A").End(xlUp).Row + 1 

我建议简化你在做什么，直到你了解它，然后把它应用到你的产品代码。以下内容应该可以帮助您解决问题，以便解决问题。

打开一个新的工作簿并在单元格A1，A2和A3中键入值。不管你输入什么内容，我们只需要一些工作。

现在添加一个模块并粘贴在此代码：

Sub CopyToEndOfColumnOnAnotherSheet() 
    Dim wb As Workbook 
    Dim src As Worksheet 
    Dim tgt As Worksheet 
    Dim tgtLastRow As Long 

    Set wb = ThisWorkbook 
    Set src = wb.Sheets("Sheet1") 
    Set tgt = wb.Sheets("Sheet2") 

    tgtLastRow = tgt.Cells(Rows.Count, "A").End(xlUp).Row + 1 
    src.Range("A1:A3").Copy tgt.Range("A" & tgtLastRow) 
End Sub 

每次运行它的时候，从Sheet1 3点的值将被复制到Sheet 2上的范围的结束。