¿Crear una macro que inserte datos nuevos debajo de la última input?

Soy nuevo en el mundo de VBA y Macro. Estoy tratando de crear una hoja de recostackción de datos. Los datos de la primera parte se recostackn de 1 libro de trabajo y se colocan en el libro maestro. Lo que me gustaría lograr es que los datos nuevos que extraigo se colocarán debajo de la input anterior en el libro maestro.

Sub Extract() ' ' Extract Macro ' ' Keyboard Shortcut: Ctrl+e ' Sheets("For Coordinator Use").Select Range("A2:M41").Select Selection.Copy Windows("Nimble Schedule Import Template- ops.xlsx").Activate Range("A1000").End(xlUp).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _ "=0", Operator:=xlOr, Criteria2:="=" Application.CutCopyMode = False Selection.EntireRow.Delete ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1 Windows("Coverage Request Form (9).xlsx").Activate Sheets("Request Form").Select End Sub 

Aquí hay una copy modificada y comentada de su código:

 Sub Extract() ' ' Extract Macro ' ' Keyboard Shortcut: Ctrl+e ' Sheets("For Coordinator Use").Select Range("A2:M41").Copy 'No need to select then copy, just copy is fine Windows("Nimble Schedule Import Template- ops.xlsx").Activate 'I have offset the last row of data by 1 row below, use rows.count rather than a hard row number. Also no need to select Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="=0", Operator:=xlOr, Criteria2:="=" 'I don't know what row is selected here but it was in your code so I left it, also no need for cutcopymode as it will cancel when you delete anyway Selection.EntireRow.Delete ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1 Windows("Coverage Request Form (9).xlsx").Activate Sheets("Request Form").Select End Sub 

Lea los comentarios y formule cualquier pregunta al respecto si no está seguro. Estos cambios se deben a que ha estipulado que es nuevo en esto y no quiero confundirlo, esta NO es la mejor manera de hacerlo, prefiero configurar algo con arreglos que copyr y pegar. Si te sientes cómodo con este post de concepto, modificaré mi código por ti.

Depende de cómo te gustaría hacerlo. ¿Desea tal vez utilizar una matriz para almacenar los datos en luego extraer a la spreadsheet maestra o simplemente desea utilizar funciones incorporadas para copyr y pegar los datos como lo hace arriba. También puede usar un dictionary de secuencias de commands para almacenar los datos; también hay muchas maneras de hacerlo, simplemente preguntándose qué ruta desea tomar. Si desea tener una macro de alto performance, le sugiero que no use las funciones incorporadas de Excel, ya que son más lentas que el uso de matrices.

Actualización 2015-08-20 Tengo la copy y pegar usando el object range. Sin embargo, veo que desea eliminar algunos otros valores de su list, aunque se guardan en una tabla y no en una spreadsheet. ¿Es esto correcto? Por favor, eche un vistazo al código. Hice algunos comentarios pidiendo algunas aclaraciones. Perdón por tomar tanto time que estaba ocupado terminando algo en el trabajo.

 Sub Extract() ' ' Extract Macro ' ' Keyboard Shortcut: Ctrl+e ' Dim wb As Workbook, ws As Worksheet, rng As Range Set wb = ThisWorkbook 'Set up the Excel objects you want to use Set ws = wb.Worksheets("For Coordinator Use") Set rng = ws.Range("A2:M41") 'asuming this is not changing 'Sheets("For Coordinator Use").Select 'You do not need to select if you use the objects 'Range("A2:M41").Select 'You do not need to select if you use the objects 'Selection.Copy 'you can also get rid of this if using objects Dim wbDest As Workbook, wsDest As Worksheet, rngDest As Range Set wbDest = Application.Workbooks("Nimble Schedule Import Template- ops.xlsx") ' Assuming that it is opened 'Windows("Nimble Schedule Import Template- ops.xlsx").Activate 'dont need to activate anything Set wsDest = wbDest.Worksheets("Sheet1") Set rngDest = wsDest.Range("A1:A35000") ''optimize the application Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False '''' '''Find the first empty cell in destRng 'Range("A1000").End(xlUp).Select ' this will select the range that is blank only if it does not have data to begin with Dim i As Long, j As Long, rngAdd As String 'i is the counter and j stores the row where it is blank For i = 1 To rngDest.Cells.Count If IsEmpty(rngDest.Cells(i, 1).Value) Then j = i i = rngDest.Cells.Count End If Next i 'reset the rngDest Set rngDest = Nothing rngAdd = "A" & j & ":M" & (j + 39) Set rngDest = wsDest.Range(rngAdd) 'make rngDest = rng.Value since they have the same dimension this works rngDest = rng.Value 'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ ' :=False, Transpose:=False 'I am not sure what you are trying to acheive here a filter??'ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _ ' "=0", Operator:=xlOr, Criteria2:="=" 'Application.CutCopyMode = False 'Selection.EntireRow.Delete 'ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1 ''Looks like you are deleting all with a value of "=0" 'Windows("Coverage Request Form (9).xlsx").Activate 'Sheets("Request Form").Select 'Release Objects Set rngDest = Nothing Set wsDest = Nothing Set wbDest = Nothing Set rng = Nothing Set ws = Nothing Set wb = Nothing ''set excel optimization as normal again Application.ScreenUpdating = True Application.Calculation = xlCalculationAuto Application.EnableEvents = True End Sub