Выберите указанный диапазон для имен изменяющихся листов из другой книги Excel - VBA - PullRequest
0 голосов
/ 28 ноября 2018

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

У меня есть рабочие книги с разными именами в папке.У меня есть мой список VBA пути к файлам .csv.

Каждая рабочая книга имеет уникальное имя, идентичное листу внутри.

Далее я хочу просмотреть циклы рабочих книг, объединяющихся в MASTER.xlsm

Данные изOBDII Car App, поэтому количество строк всегда неизвестно.

Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
  SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
  Cells.Find(What:="*", SearchOrder:=xlByColumns, _
  SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select

Этот код выше работал, когда я использовал его в одной из различных рабочих книг вручную.Но я получаю

Ошибка времени выполнения 1004 Ошибка приложения или объекта

, когда я пытаюсь реализовать ее из MasterWorkbook.

Private Sub cmd_COPYpaste()

Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.Calculation = xlCalculationManual

''''DIMMENSIONS

Dim SourceRow As Long
Dim EditRow As Long
Dim sFile As String
Dim wb As Workbook
Dim FileName1 As String
Dim wksSource As Worksheet
Const scWkbSourceName As String = "MASTER.xlsm"

Set wkbSource = Workbooks(scWkbSourceName)
Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name

Const wsOriginalBook As String = "MASTER.xlsm"

SourceRow = 2

''ENSURE SELECT SOURCE SHEET
Sheets("Sheet1").Select

Do While Cells(SourceRow, "B").Value <> ""

FileName1 = wksSource.Range("B" & SourceRow).Value

sFile = FileName1

Set wb = Workbooks.Open(sFile)

''CREATE TABLE1 ON AWORKBOOK

Dim AWorkbook As Workbook
Set AWorkbook = ActiveWorkbook

''CREATE a REFERENCE-ABLE Sheet
Dim AWorksheet As Worksheet
Set AWorksheet = AWorkbook.ActiveSheet

''SELECT DATA RANGE

следующая строка - моя ошибка

AWorksheet.Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
  SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
  Cells.Find(What:="*", SearchOrder:=xlByColumns, _
  SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select

Selection.Copy

Windows("MASTER.xlsm").Activate
Sheets("Sheet3").Select                 'IMPORT TO SHEET
ActiveSheet.Range("A1").Select
ActiveSheet.Paste

''CLOSE WORKBOOK W/O BEFORE SAVE
AWorkbook.Activate
Application.EnableEvents = False
ActiveWorkbook.Close savechanges:=False 'Will NOT save changes
Application.EnableEvents = True

Windows("MASTER.xlsm").Activate
Sheets("Sheet1").Select

'''FUTURE CODE

''GO TO NEXT FILE
SourceRow = SourceRow + 1 ' Move down 1 row for source sheet

Loop

End Sub

Я планирую завершить код в будущем, но сейчас я хочу, чтобы он копировал и вставлял в A1 на Sheet3 снова и снова.

Я застрял, думая, что что-то напутал с

''Need to CREATE a REFERENCE-ABLE Sheet
Dim AWorksheet As Worksheet
Set AWorksheet = AWorkbook.ActiveSheet

Как я могу обойтись, не зная названия листа, и все еще иметь полный контроль над листом из другой Рабочей книги?

Я думалЯ указал Активный лист AWorkbook

Столбец A в Главной рабочей тетради 1 содержит имя файла, а filename1 - Полный путь в столбце B.

Я ценю, что вы остаетесь со мной, и я хотел быуслышать ваши мысли и упрощения (опора для всех, кто получил меня так далеко)?

1 Ответ

0 голосов
/ 28 ноября 2018

Вы можете заменить свой код с:

Set wb = Workbooks.Open(sFile)

на:

Sheets("Sheet1").Select

следующим (пояснения в комментариях):

With Workbooks.Open(sFile) ' open and referecne your current workbook
    With .Worksheets(Split(.Name, ".")(0)) ' reference referenced workbook sheet named after it
        .Range("A1").Resize(.Cells.Find(What:="*", SearchOrder:=xlRows, _
                                        SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
                            .Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                                        SearchDirection:=xlPrevious, LookIn:=xlValues).Column) _
                    .Copy Destination:=Workbooks("MASTER.xlsm").Worksheets("Sheet3").Range("A1") ' copy and paste in one shot
    End With

    Application.EnableEvents = False
    .Close savechanges:=False 'Will NOT save changes
    Application.EnableEvents = True

    '''FUTURE CODE

End With

''GO TO NEXT FILE
SourceRow = SourceRow + 1 ' Move down 1 row for source sheet
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...