Блог

Главная - Вопросы по программированию - VBA, перенос выбранных данных из 50 книг Excel в одну целевую книгу Excel

VBA, перенос выбранных данных из 50 книг Excel в одну целевую книгу Excel

#excel #vba

Вопрос:

Цикл в папке-это работа, но не работают ячейки цикла, не работают копирование и вставка выбранных данных из 50 книг Excel в одну целевую книгу Excel. Я работаю в операционной системе Windows. У меня есть папка с 50 файлами Excel. У меня есть один файл destiny Excel. Данные передаются из папки в 1 отдельный файл Excel.

Помогите, пожалуйста.

 Sub Combine()
Dim s As String, MyFiles As String
Dim endd As Integer, startt As Integer
Dim NewWb As Workbook
Dim newS As Worksheet
Dim i As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set NewWb = Workbooks.Add
With NewWb
Set newS = NewWb.Worksheets("Лист1")
End With

endd = i * 10   1
startt = endd - 10

MyFiles = "C:UsersUserDesktopNezavisimaiPapka2"
s = Dir(MyFiles amp; "*.xlsx")
Do While s <> ""

    [a1] = 0
    If Dir = "" Then Exit Sub Else i = 1
    Do
        If Dir = "" Then Exit Do Else i = i   1
    Loop Until False
    [a1] = i

    With Workbooks.Open(MyFiles amp; s)

        .Worksheets("Данные").Range("A1:C10").Copy

        .Close SaveChanges:=False
    End With

 newS.Select
 With newS
     .Range("B" amp; startt amp; ":D" amp; endd).Paste
 End With

 s = Dir
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Комментарии:

1. Вопросы с кодом, выполняющим это, существуют здесь.

2. Я замечаю, что вы всегда вставляете, итерация за итерацией, в один и тот же точный диапазон newS . Возможно, вам нужно увеличить диапазон, в который вы вставляете, чтобы он не перезаписывал один и тот же целевой диапазон снова и снова? После вставки попробуйте startt = startt 10

3. JNevill, метод Copy Paste не работает на первой итерации. Только добавьте книгу и откройте первую книгу. После вставки в теории: endd = i * 10 1 startt = endd — 10

4. Солнечный Майк, где вопросы с кодом? Я не нахожу. Я нахожу это в AutoIt. Но я не могу установить файл AutoIt .exe на свой компьютер в офисе. Корпорация запретила установку программного обеспечения (.exe)

5. Ну, у меня здесь есть один, и я получил несколько ответов от хороших людей здесь.

Ответ №1:

 Option Explicit

Sub Combine()

    Const FOLDER = "C:UsersUserDesktopNezavisimaiPapka2"

    Dim wb As Workbook, wbNew As Workbook, wsNew As Worksheet
    Dim filename As String, i As Long, n As Integer, rng As Range
    
    Set wbNew = Workbooks.Add(xlWBATWorksheet) '1 sheet
    Set wsNew = wbNew.Sheets(1)
    
    Application.ScreenUpdating = False
    i = 1
    filename = Dir(FOLDER amp; "*.xlsx")
    Do While filename <> ""
        ' open book and copy range
        Set wb = Workbooks.Open(FOLDER amp; filename, False, True) ' no link update, read only
        Set rng = wb.Sheets(1).Range("A1:C10")
        rng.Copy wsNew.Range("B" amp; i)
        i = i   rng.Rows.Count
        ' close book goto next
        wb.Close False
        n = n   1
        filename = Dir
    Loop
    ' save combined
    wbNew.SaveAs ThisWorkbook.Path amp; "Combined.xlsx"
    wbNew.Close False
    Application.ScreenUpdating = True
    MsgBox n amp; " files copied", vbInformation

End Sub
Метки: ,