将不同工作表中的列粘贴到一个工作表中

Question

我遇到了以下问题，需要一些帮助：我试图将文件夹的每个 excelfile 的第一列粘贴到一个 excelsheet 中，以便第一列在 A 列中，第二列在 B 列中，依此类推。这些列始终位于每个工作簿的第一个 sheet。

这是我现在拥有的：

Sub OpenFiles()
Const FILE_PATH As String = "C:\Users\"
Dim MyFile As String
Dim objWorkbook As Workbook
Dim c As Integer
Dim destWb As Workbook


c = 1

Application.ScreenUpdating = False

MyFile = Dir$(FILE_PATH & "*.xlsx")
Set destWb = Workbooks.Open("C:\Users\Translations.xlsx")
Do Until MyFile = ""
    Set objWorkbook = Workbooks.Open(Filename:=FILE_PATH & MyFile, UpdateLinks:=3)
    objWorkbook.Worksheets(1).Range("A1:A100").Copy _
    destWb.Worksheets(1).Range(destWb.Worksheets(1).Cells(1, c)).Paste

    c = c + 1
    Call objWorkbook.Close(SaveChanges:=True)
    MyFile = Dir$
Loop
Application.ScreenUpdating = True
End Sub

无法弄清楚如何从一个工作簿复制粘贴到另一个工作簿

感谢您的帮助，

瓦伦丁

Answer 1

我使用了您的 vba 脚本并做了一些修改以在我的电脑上进行测试。复制和粘贴经常会导致错误。而且您的脚本 destWb.Worksheets(1).Range(destWb.Worksheets(1).Cells(1, c)).Paste 看起来有问题。这是我修改后的脚本，效果很好。

Sub OpenFiles()
Const FILE_PATH As String = "C:\Users\***\Desktop\vba_test\"
Dim MyFile As String
Dim objWorkbook As Workbook
Dim c As Integer
Dim i As Integer
Dim destWb As Workbook


c = 1

Application.ScreenUpdating = False

MyFile = Dir$(FILE_PATH & "*.xlsx")
Set destWb = Workbooks.Open("C:\Users\***\Desktop\dest.xlsx")
Do Until MyFile = ""
    Set objWb = Workbooks.Open(FILE_PATH & MyFile, True, True)
    For i = 1 To 20
        destWb.Worksheets(1).Cells(1, c).Offset(i - 1, 0).Value = objWb.Worksheets(1).Range("A" & i).Value
    Next i
    c = c + 1
    Call objWb.Close(SaveChanges:=False)
    Set objWb = Nothing
    MyFile = Dir$
Loop
Application.ScreenUpdating = True
End Sub

将不同工作表中的列粘贴到一个工作表中

Pasting columns from different Worksheets into one

excel

vba

copy-paste