Pasting columns from different Worksheets into one

Question

I am stuck with the following problem and need some help: I am trying to paste the first column of every excelfile of a folder into one excelsheet so that the first column is in column A and the second in column B and so on. The columns are always in the first sheet in every workbook.

Here is what i have right now:

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

it can't figure out how to copy and paste from the one Workbook to the other

Thanks for your help,

Valentin

Answer 1

I used your vba script and modified a bit to test on my pc. Copy and paste often cause error. And your script destWb.Worksheets(1).Range(destWb.Worksheets(1).Cells(1, c)).Paste looks buggy. Here is my modified script that works perfectly.

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