Вставка столбцов из разных листов в один - PullRequest
0 голосов
/ 30 апреля 2020

У меня возникла следующая проблема, и мне нужна некоторая помощь: я пытаюсь вставить первый столбец каждого файла Excel в один файл Excel, чтобы первый столбец был в столбце A, а второй - в столбце B и т. Д. , Столбцы всегда находятся на первом листе в каждой книге.

Вот то, что у меня есть сейчас:

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

, он не может понять, как копировать и вставлять из одной книги. другому

Спасибо за помощь,

Валентин

1 Ответ

0 голосов
/ 04 мая 2020

Я использовал ваш vba-скрипт и немного изменил его для тестирования на моем p c. Копирование и вставка часто вызывают ошибку. И ваш скрипт 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...