特定の範囲を別のワークシートの最初の使用可能な行にコピーして転送する

Question

以下のコードは円滑に実行され、B列から最初に使用可能な行のWorkbook1からWorkbook2にデータがコピーされます。したがって、データがサブミットされるたびに列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

これを試してみてください、それは私が正しくあなたの質問を理解していれば、あなただけの転送がworkbook1から作られた日付がworkbook2したいん一行ソリューション

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