使用VBA将数据从具有2列的excel表复制和粘贴到具有8列的excel表

Question

i like to copy table body of a 2 column table in a workbook to the first 2 columns of a 8 column table in another workbook. i wrote this code but when pasting the body to the other table i get the 2 columns repeated on column 3 and 4, 5 and 6 and 7 and 8

Dim wbk As Workbook

Sub overzetten_naar_planning()

Dim folderPath As String, fileName As String, filePath As String
Dim LastRow As Variant
Dim Wb As Workbook
Set Wb = ThisWorkbook

' create path containing the planning file
folderPath = ThisWorkbook.Path & "\"
fileName = "6s planning 2015.xlsx"
filePath = folderPath & fileName

' check if planning is already open in your session.
If IsWorkBookOpen(filePath) Then
    Set Wba = Workbooks(fileName)
Else
    Set Wba = Workbooks.Open(filePath, UpdateLinks:=0)
End If

Wba.Activate
Set LastRow = ActiveSheet.ListObjects("Planning6S").ListRows.Add
ThisWorkbook.Activate
ActiveSheet.ListObjects("WerkplaatsTabel").DataBodyRange.Copy
LastRow.Range.PasteSpecial xlPasteValues

End Sub

Function IsWorkBookOpen(fileName As String)
Dim ff As Long, ErrNo As Long

On Error Resume Next
ff = FreeFile()
Open fileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0

Select Case ErrNo
Case 0:    IsWorkBookOpen = False
Case 70:   IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function

Answer 1

The reason for the two columns repeating is in your setting of the paste range

Wba.Activate Set LastRow = ActiveSheet.ListObjects("Planning6S").ListRows.Add

LastRow is a range and your planning6S table spans 8 columns. So, if you copied 2 columns and then pasted them into a 1 row by 8 column range then Excel will repeat the two column clipboard across all 8 selected columns.

Answer 2

I'm pretty sure the problem is in these lines:

Set LastRow = ActiveSheet.ListObjects("Planning6S").ListRows.Add

...

ActiveSheet.ListObjects("WerkplaatsTabel").DataBodyRange.Copy
LastRow.Range.PasteSpecial xlPasteValues

The first line inserts a new row , which is necessary if the table is empty before the copy, but since your import table is 8 columns wide and your export table only two columns wide, the two columns will be repeated 4 times. (In keeping with Mark Fitzgerald's reply).

Try this instead:

Dim LR as variant
Set LR = ActiveSheet.ListObjects("Planning6S").DataBodyRange.Columns("A:B") 'your desired copy range`

ActiveSheet.ListObjects("WerkplaatsTabel").DataBodyRange.Copy LR

Answer 3

将其粘贴到LastRow范围的第一个左上角单元格中是否可行？

LastRow.Cells(1,1).PasteSpecial xlPasteValues