Копировать данные из разных экземпляров в одну и ту же папку - PullRequest
0 голосов
/ 04 июня 2018

Я хочу написать код на VBA, который копирует данные из разных таблиц Excel, которые находятся в одной папке, в другую Excel.Я попытался написать цикл, который просматривает различные примеры в папке, открывает их, копирует некоторый контент, а затем вставляет его в конец другой книги Excel.На последнем этапе мне придется работать с «Dim last as long», но я еще не там.

Нет замечаний по дефектам, но макрос ничего не делает.

Я новичок в VBA и буду очень благодарен за любые советы!

 Sub copypaste()
    Dim strFileName As String
    Dim strFolder As String: strFolder = "L:....xlsx"
    Dim strFileSpec As String: strFileSpec = strFolder & "*.xlsx"
    strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("strFileSpec")
Set y = Workbooks.Open("L:....xlsx")
'Now, transfer values from x to y:
y.Sheets("aaa").Range("C2:BI8").Value = x.Sheets("bbb").Range("A5:BG10")
x.Close
    strFileName = Dir
Loop
End Sub

1 Ответ

0 голосов
/ 04 июня 2018

Если ваш цикл Do выполняется, ваш код, как указано, вызовет некоторые ошибки.Поскольку это не так, я полагаю, что ваш цикл не выполняется, что вы должны были проверить, прежде чем спрашивать здесь.Если вы не знаете, как, пожалуйста, прочитайте отличный и краткий учебник Чипа Пирсона о том, как отлаживать VBA:

http://www.cpearson.com/excel/DebuggingVBA.aspx

Если ваш цикл Do не выполняется, то естьпроблема с именами ваших папок / файлов и / или реализацией функции DIR.

strFolder, например, выглядит очень подозрительно, потому что "L:....xlsx" не выглядит как действительная папка путь.

Dim strFolder As String: strFolder = "L:....xlsx"

Вот еще одна проблема.Эта строка инструктирует Excel открыть рабочую книгу (в активном каталоге) с именем "strFileSpec", это строковый литерал, а не ваша переменная с аналогичным идентификатором: strFileSpec.Поскольку эта строка не вызывает ошибку, проблема, скорее всего, указана выше (цикл не выполняется), но this также является проблемой, которую необходимо исправить:

Set x = Workbooks.Open("strFileSpec")

Должно быть:

Set x = Workbooks.Open(strFileName)

И оно должно быть strFileName (результат функции Dir), поскольку это источник вашей копии / вставки.

Кроме того, вам, вероятно, следует открыть y вне цикла и убедиться, что это действительное имя файла, которое в настоящее время не является:

Set y = Workbooks.Open("L:....xlsx")

Итак, собрав все это вместе, это:

Sub copypaste()
    Dim x As Workbook
    Dim y As Workbook
    Dim strFileName As String
    Dim strFolder As String
    Dim strFileSpec As String

    Set y = Workbooks.Open("c:\users\your_name\desktop\file.xlsx") '<< This should be the file path of the file you're copying TO.

    strFolder = "c:\users\your_name\desktop\" '<< make sure this is a valid path to a FOLDER
    strFileSpec = strFolder & "*.xlsx"
    strFileName = Dir(strFileSpec)

    Do While Len(strFileName) > 0
        Set x = Workbooks.Open("strFileSpec")

        'Now, transfer values from x to y:
        y.Sheets("aaa").Range("C2:BI8").Value = x.Sheets("bbb").Range("A5:BG10")
        x.Close
        strFileName = Dir
    Loop
End Sub

ПРИМЕЧАНИЕ вышеприведенное просто перезаписывает тот же пункт назначения диапазона, вам нужно убедиться, что выПишете в другое место назначения с каждой итерацией цикла, что-то вроде:

    Dim i as Long

    Do While Len(strFileName) > 0
        Set x = Workbooks.Open("strFileSpec")

        'Now, transfer values from x to y:
        With x.Sheets("bbb").Range("A5:BG10")
            y.Sheets("aaa").Range("C2").Resize(.Rows.Count, .Columns.Count).Offset(i).Value = .Value
            i = i + .Rows.Count + 1
        End With
        x.Close
        strFileName = Dir
    Loop
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...