首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >使用VBA将2列excel表中的数据复制粘贴到8列excel表中

使用VBA将2列excel表中的数据复制粘贴到8列excel表中
EN

Stack Overflow用户
提问于 2015-03-25 16:41:55
回答 3查看 510关注 0票数 0

我喜欢将工作簿中2列表格的表体复制到另一个工作簿中8列表格的前2列。我写了这段代码,但是当将主体粘贴到另一个表中时,我得到了在第3列和第4列、第5列和第6列以及第7列和第8列上重复的两列

代码语言:javascript
运行
复制
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
EN

回答 3

Stack Overflow用户

发布于 2015-03-25 17:25:58

两列重复的原因在于粘贴范围的设置

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

LastRow是一个范围,并且您的planning6S表跨越8列。因此,如果您复制了2列,然后将它们粘贴到1行x 8列的范围中,那么Excel将在所有8个选定列上重复两列剪贴板。

票数 0
EN

Stack Overflow用户

发布于 2015-03-25 17:34:47

我很确定问题出在下面这几行:

代码语言:javascript
运行
复制
Set LastRow = ActiveSheet.ListObjects("Planning6S").ListRows.Add

..。

代码语言:javascript
运行
复制
ActiveSheet.ListObjects("WerkplaatsTabel").DataBodyRange.Copy
LastRow.Range.PasteSpecial xlPasteValues

第一行插入一个新的,如果表在复制之前是空的,则需要执行此操作,但是由于导入表的宽度为8列,而导出表的宽度仅为2列,因此这两列将重复4次。(与Mark Fitzgerald的回答一致)。

试着这样做:

代码语言:javascript
运行
复制
Dim LR as variant
Set LR = ActiveSheet.ListObjects("Planning6S").DataBodyRange.Columns("A:B") 'your desired copy range`

ActiveSheet.ListObjects("WerkplaatsTabel").DataBodyRange.Copy LR
票数 0
EN

Stack Overflow用户

发布于 2015-03-25 17:35:08

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

代码语言:javascript
运行
复制
LastRow.Cells(1,1).PasteSpecial xlPasteValues
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/29250936

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档