Скопировать в файл один столбец со всех файлов

[Arnold9131]

Здравствуйте, уважаемые форумчани!
Есть проблема.
Нужно в отдельный файл вставить столбец H с других файлов. Файлы находятся в одной папке
Прошу прощения, если такая уже на форуме тема существует, вопрос очень срочный.



Sub Get_All_File_from_Folder()
Dim openBook, newBook As Workbook
Dim x, k, l, colrow, sumrow As Integer
Dim PK, FL As String
Set newBook = Workbooks.Open("S:\!Архив ВК\Косяки в ЭА\Для обработки\1\all.xls") ' Это файл куда будут копироваться данные
colrow = 1
'For x = 1 To 50
Set openBook = Workbooks.Open("S:\!Архив ВК\Косяки в ЭА\Для обработки\1982-5-10-2пк.xls") ' Это первый файл в папке
sumrow = ActiveSheet.Cells.SpecialCells(xlCe llTypeLastCell).Row ' Кол-во строк
For i = 2 To sumrow
newBook.Sheets(1).Cells(i + colrow, 1).Value = openBook.Sheets(1).Cells(i, 6).Text
Next i
colrow = colrow + sumrow
'Next x

End Sub

[SAS888]

Следующий макрос скопирует данные столбцов "H" 1-го листа из всех книг, находящихся в той же папке, что и файл с этим макросом, и разместит скопированные значения последовательно в столбцы на лист 1, начиная со столбца "A":

Sub qq()
    Dim wb As Workbook, ws As Worksheet, p As String, f As String, i As Long
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    p = ThisWorkbook.Path & Application.PathSeparator: f = Dir(p & "*.xls*")
    Set ws = ThisWorkbook.Sheets(1): ws.Cells.ClearContents: i = 1
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = GetObject(p & f)
            wb.Sheets(1).Columns("H").Copy
            ws.Columns(i).PasteSpecial Paste:=xlPasteValues
            wb.Close False: i = i + 1
        End If
        f = Dir
    Loop
    Application.CutCopyMode = False: ws.Activate: [A1].Select
End Sub

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

[Arnold9131]

Сообщение от SAS888

Следующий макрос скопирует данные столбцов "H" 1-го листа из всех книг, находящихся в той же папке, что и файл с этим макросом, и разместит скопированные значения последовательно в столбцы на лист 1, начиная со столбца "A":

Sub qq()
    Dim wb As Workbook, ws As Worksheet, p As String, f As String, i As Long
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    p = ThisWorkbook.Path & Application.PathSeparator: f = Dir(p & "*.xls*")
    Set ws = ThisWorkbook.Sheets(1): ws.Cells.ClearContents: i = 1
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = GetObject(p & f)
            wb.Sheets(1).Columns("H").Copy
            ws.Columns(i).PasteSpecial Paste:=xlPasteValues
            wb.Close False: i = i + 1
        End If
        f = Dir
    Loop
    Application.CutCopyMode = False: ws.Activate: [A1].Select
End Sub

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

Макрос у меня не работает.
Буду очень благодарен, если опишите за что отвечают некоторые строчки кода.

[SAS888]

Посмотрите пример во вложении.
Откройте файл "Main.xls" и запустите макрос "Sbor".
В коде макроса подробные комментарии.

[Arnold9131]

Сообщение от SAS888

Следующий макрос скопирует данные столбцов "H" 1-го листа из всех книг, находящихся в той же папке, что и файл с этим макросом, и разместит скопированные значения последовательно в столбцы на лист 1, начиная со столбца "A":

Sub qq()
    Dim wb As Workbook, ws As Worksheet, p As String, f As String, i As Long
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    p = ThisWorkbook.Path & Application.PathSeparator: f = Dir(p & "*.xls*")
    Set ws = ThisWorkbook.Sheets(1): ws.Cells.ClearContents: i = 1
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = GetObject(p & f)
            wb.Sheets(1).Columns("H").Copy
            ws.Columns(i).PasteSpecial Paste:=xlPasteValues
            wb.Close False: i = i + 1
        End If
        f = Dir
    Loop
    Application.CutCopyMode = False: ws.Activate: [A1].Select
End Sub

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

Вроде заработал, но он только с одного файла копирует данные и то неполностью, и вставляет не в столбец "H".

[SAS888]

Вроде заработал, но он только с одного файла копирует данные и то неполностью, и вставляет не в столбец "H".

1. Код нужно располагать не в модуле листа, а в программном модуле.
2. Даже не смотря на это, код рабочий. Я специально прикрепил несколько файлов с данными из которых макрос извлекает значения (если, конечно, они располагаются в этой же папке.
3. Как я уже говорил, макрос извлекает значения из столбцов "H" каждого файла и располагает их на свой 1-й лист, начиная со столбца "A". Т. е. данные из столбца "H" 1-го файла-источника будут помещены в столбец "A". Из из столбца "H" следующего файла - в столбец "B" и т. д. Вы же говорили, что

Нужно в отдельный файл вставить столбец H с других файлов.

Именно это и происходит. Укажите конкретно, какие данные (из каких файлов, каких листов и каких диапазонов требуется получить и КУДА ИХ ПОМЕЩАТЬ?

[Arnold9131]

Сообщение от SAS888

1. Код нужно располагать не в модуле листа, а в программном модуле.
2. Даже не смотря на это, код рабочий. Я специально прикрепил несколько файлов с данными из которых макрос извлекает значения (если, конечно, они располагаются в этой же папке.
3. Как я уже говорил, макрос извлекает значения из столбцов "H" каждого файла и располагает их на свой 1-й лист, начиная со столбца "A". Т. е. данные из столбца "H" 1-го файла-источника будут помещены в столбец "A". Из из столбца "H" следующего файла - в столбец "B" и т. д. Вы же говорили, что Именно это и происходит. Укажите конкретно, какие данные (из каких файлов, каких листов и каких диапазонов требуется получить и КУДА ИХ ПОМЕЩАТЬ?

Нужно извлечь значения из столбцов "H" каждого файла и записать их в отдельный файл в столбец "H". Т.е. все извлеченные данные должны быть вставлены в отдельный файл в столбец "H".
В этих файлах только по одному листу, так что перебирать листы не нужно.

[Pasha_Z]

Сообщение от Arnold9131

Нужно извлечь значения из столбцов "H" каждого файла и записать их в отдельный файл в столбец "H". Т.е. все извлеченные данные должны быть вставлены в отдельный файл в столбец "H".
В этих файлах только по одному листу, так что перебирать листы не нужно.

так понимается, что извлекаются непустые данные из столбца Н
и последовательно вставляются в новый файл столба Н.
а не весь столбец Н переносит.

[Arnold9131]

Сообщение от Pasha_Z

так понимается, что извлекаются непустые данные из столбца Н
и последовательно вставляются в новый файл столба Н.
а не весь столбец Н переносит.

Да, надо извлечь только ячейки с данными "H" (в основном в них содержатся ссылки), и последовательно их вставить в новый файл столбца "H".

[SAS888]

...в основном в них содержатся ссылки...

А данные полученные по этим ссылкам в ячейках присутствуют? Ссылки на реально существующий источник? Обновлять данные по этим ссылкам при открытии?
Прикрепите пример с хотя бы одним файлом, из которого нужно брать данные. Можно с "липовыми" значениями (яблоки, груши...).