Note that there are some explanatory texts on larger screens.

plurals
  1. POExcel 2007 VBA: How do I copy and paste from a dynamic range on one sheet to the first empty row of another sheet?
    primarykey
    data
    text
    <p>My question is similar to the question answered here ( <a href="https://stackoverflow.com/a/17071905/2506351">https://stackoverflow.com/a/17071905/2506351</a> ) except that I need the data to be pasted to the first empty row of the other sheet. I've tried using <code>lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1</code> but that doesn't work. Here's a copy of my complete code so far......</p> <pre><code>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" &amp; lngLastRow) .AutoFilter .AutoFilter Field:=1, Criteria1:="COM" .Copy COMSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="COR" .Copy COMROLLSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="CF1" .Copy CFUSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="EP2" .Copy EPS2Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="EP3" .Copy EPS3Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="ER1" .Copy ER1Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="ER2" .Copy ER2Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="FIP" .Copy FIPSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="HDW" .Copy HDWSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="RP2" .Copy RPS2Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="RP3" .Copy RPS3Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="RP4" .Copy RPS4Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="RR4" .Copy RR4Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="CH1" .Copy SCHSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="CR1" .Copy SCHROLLSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="TAC" .Copy TACSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="TAR" .Copy TARSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="TR1" .Copy TR1Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="TR2" .Copy TR2Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="WIN" .Copy WINSheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="W2" .Copy WIN2Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter .AutoFilter Field:=1, Criteria1:="W3" .Copy WIN3Sheet.Range("B" &amp; .Rows.Count).End(xlUp).Row + 1 .AutoFilter End With Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub </code></pre> <p>With much help from Head Of Catering, I came up with the following as my final code:</p> <pre><code>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" &amp; lngLastRow) .AutoFilter .AutoFilter Field:=1, Criteria1:="COM" .Copy tgtCom.Range("B" &amp; tgtLRCom) .AutoFilter .AutoFilter Field:=1, Criteria1:="COR" .Copy tgtComRoll.Range("B" &amp; tgtLRComRoll) .AutoFilter .AutoFilter Field:=1, Criteria1:="CF1" .Copy tgtCFU.Range("B" &amp; tgtLRCFU) .AutoFilter .AutoFilter Field:=1, Criteria1:="EP2" .Copy tgtEPS2.Range("B" &amp; tgtLREPS2) .AutoFilter .AutoFilter Field:=1, Criteria1:="EP3" .Copy tgtEPS3.Range("B" &amp; tgtLREPS3) .AutoFilter .AutoFilter Field:=1, Criteria1:="ER1" .Copy tgtER1.Range("B" &amp; tgtLRER1) .AutoFilter .AutoFilter Field:=1, Criteria1:="ER2" .Copy tgtER2.Range("B" &amp; tgtLRER2) .AutoFilter .AutoFilter Field:=1, Criteria1:="FIP" .Copy tgtFIP.Range("B" &amp; tgtLRFIP) .AutoFilter .AutoFilter Field:=1, Criteria1:="HDW" .Copy tgtHDW.Range("B" &amp; tgtLRHDW) .AutoFilter .AutoFilter Field:=1, Criteria1:="RPS2" .Copy tgtRPS2.Range("B" &amp; tgtLRRPS2) .AutoFilter .AutoFilter Field:=1, Criteria1:="RP3" .Copy tgtRPS3.Range("B" &amp; tgtLRRPS3) .AutoFilter .AutoFilter Field:=1, Criteria1:="RP4" .Copy tgtRPS4.Range("B" &amp; tgtLRRPS4) .AutoFilter .AutoFilter Field:=1, Criteria1:="RR4" .Copy tgtRR4.Range("B" &amp; tgtLRRR4) .AutoFilter .AutoFilter Field:=1, Criteria1:="CH1" .Copy tgtSCH.Range("B" &amp; tgtLRSCH) .AutoFilter .AutoFilter Field:=1, Criteria1:="CR1" .Copy tgtSCHROLL.Range("B" &amp; tgtLRSCHROLL) .AutoFilter .AutoFilter Field:=1, Criteria1:="TAC" .Copy tgtTAC.Range("B" &amp; tgtLRTAC) .AutoFilter .AutoFilter Field:=1, Criteria1:="TAR" .Copy tgtTAR.Range("B" &amp; tgtLRTAR) .AutoFilter .AutoFilter Field:=1, Criteria1:="TR1" .Copy tgtTR1.Range("B" &amp; tgtLRTR1) .AutoFilter .AutoFilter Field:=1, Criteria1:="TR2" .Copy tgtTR2.Range("B" &amp; tgtLRTR2) .AutoFilter .AutoFilter Field:=1, Criteria1:="WIN" .Copy tgtWIN.Range("B" &amp; tgtLRWIN) .AutoFilter .AutoFilter Field:=1, Criteria1:="W2" .Copy tgtWIN2.Range("B" &amp; tgtLRWIN2) .AutoFilter .AutoFilter Field:=1, Criteria1:="W3" .Copy tgtWIN3.Range("B" &amp; tgtLRWIn3) .AutoFilter End With Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub </code></pre>
    singulars
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload