Проблем при създаването на код
10 отговора
0 прегледа
Проблем при създаването на код
Здравейте,
Опитвам се да създада макрос, който трябва да прави следното:
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
Получавам грешка още в началото. Някакви идеи ?
Опитвам се да създада макрос, който трябва да прави следното:
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 на
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 листа, при това с еднакви имена и да се опитва да ги слага в основния файл. Едва ли е това което искаш...
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н на
Re: Проблем при създаването на код
Да променливата трябва да има стойността на една клетка, но след като копира първият sheet, трябва да продължи със следващият и така със всички 27. Но грешката наистина е още в частта, която съм оцветил в жълто.
Идеята е че от отделните файлове, които има по 2 sheet-a, един конкретен/който е описан в range-a/ трябва да се копира в основния файл във определен sheet.
Но сега като гледам на свежа глава, мисля че така няма да се получи.
Благодаря ти все пак за отговора, ще продължавам да го мъча.
Идеята е че от отделните файлове, които има по 2 sheet-a, един конкретен/който е описан в range-a/ трябва да се копира в основния файл във определен sheet.
Но сега като гледам на свежа глава, мисля че така няма да се получи.
Благодаря ти все пак за отговора, ще продължавам да го мъча.
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 в България
я пробвай това
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н на
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")
Worksheets("MainMenu").Cells(Rows.Count, "M").Select
Selection.End(xlUp).Select
Lastemployee = ActiveCell.Row
и виж къде ще ти даде грешка. Може и да напишеш каква грешка точно ти дава.
Всъщност, сега забелязвам:
Worksheets("MainMenu").Cells("K2").Value - такова обръщение не се допуска!
Трябва да е или Cells(2, 11), или Range("K2")
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\"
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\"
Re: Проблем при създаването на код
А, сигурен ли си, че имаш лист MainMenu, провери си буквичките, дали са точни.
Пробвай и без ".Value" накрая
Пробвай и без ".Value" накрая
Re: Проблем при създаването на код
Точно преди да ти прочета мнението го видях, не е истина 2 дни си убих заради тази глупост. Един интервал ми е липсвал sheet-а се казва "Main Menu".
Редактирано от t9OOO на
Re: Проблем при създаването на код
чудя се как не ти дава грешка още тук:
Filename = Worksheets("Main Menu").Cells("1,13").Value
трябва да е:
Filename = Worksheets("Main Menu").Cells(1,13).Value
Filename = Worksheets("Main Menu").Cells("1,13").Value
трябва да е:
Filename = Worksheets("Main Menu").Cells(1,13).Value
Re: Проблем при създаването на код
Трия защото не искам да се превръща темата в нещо от сорта на, ето какво съм направил оправете ми го.
Ще го огледам спокойно за точно такива грешка като тази с кавичките от предният ти пост.
Ще го огледам спокойно за точно такива грешка като тази с кавичките от предният ти пост.