Проблем при създаването на код

10 отговора 0 прегледа
#1

Проблем при създаването на код

Здравейте,

Опитвам се да създада макрос, който трябва да прави следното:
1. По зададен път до директория да отвори един по един всички файлове, който се намират там от тях да избере конкретен sheet, да го копира и пейстне обратно в основният файл в кореспондиращ sheet.

В основният файл имам един работен sheet наречен "MainMenu" и 27 sheet-а, който отговарят на 27 файла в работната папка.

В sheet "MainMenu":
В клетка "K2" - пътя до директорията. Примерно: "Y:\2009\Actual\"
В клетки "M1:M27" имената на файловете. Примерно "Model 1.xls
В клетки "N1:N27" имената на sheet-овете в тези файлове. Примерно "Q1,2009"

Ето какво съм направил, но не мога да го накарам да сработи:


Sub CopyData()

Dim I As Long
Dim Filepath As String
Dim Lastemployee As Long
Dim Filename As String

Lastemployee = Worksheets("MainMenu").Cells(Rows.Count, "M").End(xlUp).Row

For I = 1 To Lastemployee
Filepath = Worksheets("MainMenu").Cells("K2").Value
Filename = Worksheets("MainMenu").Cells("M4:M30").Value
Workbooks.Open Filename:=Filepath & Filename, _
ReadOnly:=True, UpdateLinks:=3


Dim b As Long
Dim lastsheet As Long
lastsheet = Worksheets("MainMenu").Cells(Rows.Count, "N").End(xlUp).Row
For b = 1 To lastsheet

Cells.Select
Selection.Copy
Windows("MasterFile").Activate
Sheets("Lastsheet").Select
Cells.Select
ActiveSheet.Paste

Next b
Next I

End Sub

Получавам грешка още в началото. Някакви идеи ?

Редактирано от t9OOO на

Отговор
в отговор на t9OOO #2

Re: Проблем при създаването на код

Пробвай с това
Lastemployee = Worksheets("MainMenu").Range("M65536").End(xlUp).Row

Ако правилно разбирам искаш да разбереш кой е последния ред на колона М в който има нещо, нали?

Лично според мен, това Cells(Rows.Count, "M") е проблема.

Добавка в 21:58 Първата част на отговора я написах преди да тръгна от офиса, като приех че си оцветил този ред, защото там ти дава грешка при дебгването. Сега в къщи видах, че това което мислех че е грешка - Cells(Rows.Count, "M") всъщност си е ОК. На второ четене ми се струва че проблема е в


Filename = Worksheets("MainMenu").Cells("M4:M30").Value

Би трябвало да бъде


Filename = Worksheets("MainMenu").Cells(I, 13).Value

Дефакто искаш да присвоиш на променливата стойността не една клетка, а не стойностите на всички клетки от 4 до 30 ред, нали (не че е възможно да го направиш де ).
Освен това ми се струва че втория цикъл също ще ти създаде проблем - така както си го написал, от всеки файл ще иска да копира по 27 листа, при това с еднакви имена и да се опитва да ги слага в основния файл. Едва ли е това което искаш...

Редактирано от Бypaн на

Отговор
в отговор на Бypaн #3

Re: Проблем при създаването на код

Да променливата трябва да има стойността на една клетка, но след като копира първият sheet, трябва да продължи със следващият и така със всички 27. Но грешката наистина е още в частта, която съм оцветил в жълто.

Идеята е че от отделните файлове, които има по 2 sheet-a, един конкретен/който е описан в range-a/ трябва да се копира в основния файл във определен sheet.
Но сега като гледам на свежа глава, мисля че така няма да се получи.
Благодаря ти все пак за отговора, ще продължавам да го мъча.

Отговор
в отговор на t9OOO #4

Re: Проблем при създаването на код

Мисля, че ти дава грешката в последния ред преди цикъла, където всъщност е грешката. Малко е шантаво...

я пробвай това

Sub CopyData()

Dim I As Long
Dim Filepath As String
Dim Lastemployee As Long
Dim Filename As String
Dim MySheetName As String

Lastemployee = Worksheets("MainMenu").Cells(Rows.Count, "M").End(xlUp).Row
Filepath = Worksheets("MainMenu").Cells("K2").Value

For I = 1 To Lastemployee

Filename = Worksheets("MainMenu").Cells(I, 13).Value
MySheetName = Worksheets("MainMenu").Cells(I, 14).Value
Workbooks.Open Filename:=Filepath & Filename, _
ReadOnly:=True, UpdateLinks:=3
Worksheets(MySheetName).Copy After:=Workbooks("MasterFile.xls").Sheets(Sheets.Count)
Workbooks(Filename).Close SaveChanges:=False
Next I

Workbooks("MasterFile.xls").Save


End Sub

Geocaching в България

Редактирано от Бypaн на

Отговор
в отговор на t9OOO #5

Re: Проблем при създаването на код

И при мен въпросният ред работи. Пробвай да го разбиеш така:

Worksheets("MainMenu").Cells(Rows.Count, "M").Select
Selection.End(xlUp).Select
Lastemployee = ActiveCell.Row

и виж къде ще ти даде грешка. Може и да напишеш каква грешка точно ти дава.

Всъщност, сега забелязвам:
Worksheets("MainMenu").Cells("K2").Value - такова обръщение не се допуска!
Трябва да е или Cells(2, 11), или Range("K2")

Отговор
в отговор на zhitov #6

Re: Проблем при създаването на код

Както и да го мъча винаги ми дава грешка в този ред:

Filepath = Worksheets("MainMenu").Cells(2, 11).Value

Lastemployee = Worksheets("MainMenu").Cells(Rows.Count, "N").Select
Selection.End(xlUp).Select
Lastemployee = ActiveCell.Row

Но не разбирам защо, в клетка К2 е написано следното:

"Y:\2009\ACTUAL\09-02\Models Q2\"

Отговор
в отговор на t9OOO #7

Re: Проблем при създаването на код

А, сигурен ли си, че имаш лист MainMenu, провери си буквичките, дали са точни.
Пробвай и без ".Value" накрая

Отговор
в отговор на nepukis #8

Re: Проблем при създаването на код

Точно преди да ти прочета мнението го видях, не е истина 2 дни си убих заради тази глупост. Един интервал ми е липсвал sheet-а се казва "Main Menu".

Редактирано от t9OOO на

Отговор
в отговор на t9OOO #9

Re: Проблем при създаването на код

чудя се как не ти дава грешка още тук:
Filename = Worksheets("Main Menu").Cells("1,13").Value
трябва да е:
Filename = Worksheets("Main Menu").Cells(1,13).Value

Отговор
в отговор на t9OOO #10

Re: Проблем при създаването на код

Много бързо триеш

Отговор
в отговор на nepukis #11

Re: Проблем при създаването на код

Трия защото не искам да се превръща темата в нещо от сорта на, ето какво съм направил оправете ми го.
Ще го огледам спокойно за точно такива грешка като тази с кавичките от предният ти пост.

Отговор