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上的範圍的結束。