将特定范围复制到另一个工作表中的第一个可用行并转置

下面的代码运行平稳，并将数据从Workbook1复制到第一个可用行的Workbook2，从B列开始。我需要知道数据何时提交，因此希望将时间和date插入到第一个可用单元格中在A列中每次数据被忽略。 谢谢你的帮助！

Option Explicit Sub MoveData() 'Define variables Dim Workbook1 As Workbook Dim Workbook2 As Workbook Dim wb As Workbook Dim ws As Worksheet Dim LastRow As Long, DestLastRow As Long 'Set wb Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") 'Copy (In this case I want to copy range D4:D7 only, and this will be the same every time) ThisWorkbook.Sheets("Sheet1").Range("D4:D7").Copy 'Open Workbook 2 and paste data (transposed) on first available row starting in column B Set Workbook2 = Workbooks.Open("H:\Macro FSC\Forsøk10\Workbook2.xlsm") With Workbook2.Sheets("Sheet1") ' find last row with data in destination workbook "Workbook2.xlsm" DestLastRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Row 'paste special only values, and transpose .Range("B" & DestLastRow).PasteSpecial xlValues, Transpose:=True End With 'Save and close Workbook2.Save Workbook2.Close End Sub 

Answer 1

试试这个，这是一个单行的解决scheme

 Option Explicit Sub MoveData() 'Define variables Dim Workbook1 As Workbook Dim Workbook2 As Workbook Dim wb As Workbook Dim ws As Worksheet Dim LastRow As Long, DestLastRow As Long 'Set wb Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") 'Copy (In this case I want to copy range D4:D7 only, and this will be the same every time) ThisWorkbook.Sheets("Sheet1").Range("D4:D7").Copy 'Open Workbook 2 and paste data (transposed) on first available row starting in column B Set Workbook2 = Workbooks.Open("H:\Macro FSC\Forsøk10\Workbook2.xlsm") With Workbook2.Sheets("Sheet1") ' find last row with data in destination workbook "wbDatabase.xlsm" DestLastRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Row 'paste special only values, and transpose .Range("B" & DestLastRow).PasteSpecial xlValues, Transpose:=True 'Added line here: .range("A1").Value = now End With 'Save and close Workbook2.Save Workbook2.Close End Sub