Question

我对VBA很新，我很难让代码工作。我知道这里有很多类似的问题，但我找不到合适的粘贴配方。我需要从工作表中复制数据＆＃34; Workbook1＆＃34;并将其粘贴到＆＃34; Workbook2＆＃34;中的下一个可用行中。工作表，转置。谢谢你的帮助。

到目前为止，我已经：

Sub MoveData()

'Define variables
Dim Workbook1 As Workbook
Dim Workbook2 As Workbook
Dim wb As Workbook
Dim ws As Worksheet

Dim LastRow As Long

'Set and Open
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

'Copy and paste
wb.ws.Range("A1:A5").Copy
Set Workbook2 = Workbooks.Open("H:\Macro\Workbook2")
Workbook2.Sheets("Sheet1").Range("A1:M & LastRow").PasteSpecial Transpose:=True

End Sub

Answer 1

以下代码查找＆＃34; Sheet1＆＃34;中的最后一行在ThisWorkbook中，复制A列中的整个范围，然后将其粘贴到＆＃34; Sheet1＆＃34;中的第一个可用行。在＆＃34; Workbook2.xlsm＆＃34;。 Paste方法使用PasteSpecial，仅限值和Transpose。

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")

' set and open Workbook2, need to add the file extenstion (.xlsm)
Set Workbook2 = Workbooks.Open("H:\Macro\Workbook2.xlsm")

With ws
    ' find last row with data in Column A to copy
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A1:A" & LastRow).Copy
End With

With Workbook2.Sheets("Sheet1")
    ' find last row with data in destination workbook "Workbook2.xlsm"
    DestLastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row
    ' paste special only values, and transpose
    .Range("A" & DestLastRow).PasteSpecial xlValues, Transpose:=True
End With

End Sub

在第一个可用行中将数据从一个工作表复制到另一个工作表并进行转置

1 个答案: