有一个macros启动，需要它find并粘贴到列D中的下一个可用的单元格

这是我目前的macros：

Sub Macro1（）

Dim newRow As Integer Dim rng As Range Set rng = Selection newRow = InputBox("Paste Where?") Workbooks("SSO_TFR_SUMMARY").Worksheets("Sheet1").Cells(newRow, 4).Value = Worksheets("Main Circuit").Cells(rng.Row, 15).Value Workbooks("SSO_TFR_SUMMARY").Worksheets("Sheet1").Cells(newRow, 5).Value = Worksheets("Main Circuit").Cells(rng.Row, 16).Value Workbooks("SSO_TFR_SUMMARY").Worksheets("Sheet1").Cells(newRow, 6).Value = Worksheets("Main Circuit").Cells(rng.Row, 6).Value Workbooks("SSO_TFR_SUMMARY").Worksheets("Sheet1").Cells(newRow, 7).Value = Worksheets("Main Circuit").Cells(rng.Row, 17).Value 

结束小组

我正在从一个工作簿中的4个单元格获取数据，并将其粘贴到一个新的工作簿中。 select要复制的行工作正常，因为确实没有简单的方法来区分需要复制的内容。 目前macros已经将我input的数据应该粘贴到新的工作簿中。 如何修改这个search每次我运行它并自动进入下一个可用点？

我已经search并find多个解决scheme，将search下一个空单元，但我不能让他们的工作。

提前致谢！

Answer 1

未经testing

 Sub macro1() Dim rng As Range Dim lastRow As Long Dim book1 As Workbook Dim book2 As Workbook Dim sheet1 As Worksheet Dim sheet2 As Worksheet Set book1 = Workbooks("SSO_TFR_SUMMARY") Set book2 = Workbooks("name of book here") 'change name Set sheet1 = book1.WorkSheets("Sheet1") Set sheet2 = book2.WorkSheets("Main Circuit") Set rng = sheet2.Selection lastRow = sheet1.Cells(sheet1.Rows.count, "D").End(xlUp).Row + 1 With sheet1 .Cells(lastRow, 4).Value2 = sheet2.Cells(rng.Row, 15).Value2 .Cells(lastRow, 5).Value2 = sheet2.Cells(rng.Row, 16).Value2 .Cells(lastRow, 6).Value2 = sheet2.Cells(rng.Row, 6).Value2 .Cells(lastRow, 7).Value2 = sheet2.Cells(rng.Row, 17).Value2 End With End Sub