Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 63656 Skopiuj do schowka Otwieranie plików i kopiowanie do wielu arkuszy
Autor Wiadomość
michael0510 
Stały bywalec Excelforum



Pomógł: 6 razy
Posty: 434
Wysłany: 02-01-2019, 23:32   Otwieranie plików i kopiowanie do wielu arkuszy

Witam
Działanie makra:
1) Otwórz kolejno plik z nazw wpisanych w arkuszu Instrukcja w komórkach C24:C27
2) Przekopiuj dane z/do arkuszy (nazwy zapisane również w Instrukcji w komórkach K24:K56)
3) Określa gdzie ma być kopiowane
4) Kopiuje dane do odpowiedniego arkusza
5) Posortowanie od Z do A
6) Zamknięcie pliku

Problem, na razie makro otwiera wielokrotnie Workbook ze względu na wiele arkuszy
Cel => poprawienie aby otwierał się plik raz w tym momencie:

Kod:
Workbooks.Open (full_name) '<<= TUTAJ CHCĘ WYKONAĆ PROCEDURĘ OPEN WORKBOOKS


A tutaj tylko przekazywał nazwę a nie otwierał się za każdym razem
Kod:
Set CopyToWorkbook = Workbooks.Open(full_name)  '<<=TUTAJ CHCIAŁBYM USTALIĆ ZMIENNĄ WORKBOOK GDZIE BĘDĄ KOPIOWANE DANE, ALE NIE CHCĘ GO OTWIERAĆ

Kod:
Set CopyToWorksheet = CopyToWorkbook.Worksheets(wks_name)


Pełny kod:
Kod:
Option Explicit

Sub create_files()
Dim file_name As Variant
Dim wks_name As String
Dim full_name As Variant
Dim rng_files As Range
Dim worksheet_name As Variant
Dim rng_worksheet As Range
Dim CopyToWorkbook As Workbook
Dim CopyToWorksheet As Worksheet
Dim sciezka As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'open the file
'=======================================================

sciezka = ThisWorkbook.Path & "\"
Set rng_files = wks_instrukcja.Range("C24:C27") 'range for file name
For Each file_name In rng_files
    full_name = sciezka & file_name & ".xlsm"
   
    'Workbooks.Open (full_name) '<<= TUTAJ CHCĘ WYKONAĆ PROCEDURĘ OPEN WORKBOOKS
                   
            Set rng_worksheet = wks_instrukcja.Range("K24:K56")
                For Each worksheet_name In rng_worksheet
                    If worksheet_name.Offset(0, -4) = file_name Then
                        'copy paste data to file
                        '=======================================================
                        'Range to Copy from Sheet with all data: B14:Q100
                        wks_name = worksheet_name 'set as string due to Variant is not working with Worksheets(wks_name)
                        Set CopyToWorkbook = Workbooks.Open(full_name)  '<<=TUTAJ CHCIAŁBYM USTALIĆ ZMIENNĄ WORKBOOK GDZIE BĘDĄ KOPIOWANE DANE, ALE NIE CHCĘ GO OTWIERAĆ
                        Set CopyToWorksheet = CopyToWorkbook.Worksheets(wks_name)
                        ThisWorkbook.Worksheets(wks_name).Range("B14:Q100").Copy
                        CopyToWorksheet.Range("B14").PasteSpecial Paste:=xlPasteValues
                        'sort Z to A data in column in Sheet with all data
                        '=======================================================
                       
                            CopyToWorksheet.AutoFilter.Sort.SortFields.Clear
                            CopyToWorksheet.AutoFilter.Sort.SortFields.Add Key:=Range("AK19:AK100"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                            With CopyToWorksheet.AutoFilter.Sort
                                .Header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                       

                        'close the file
                        '=======================================================
                        CopyToWorkbook.Close savechanges:=True
                    End If
                   
                Next worksheet_name

Next file_name

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
ID posta: 359517 Skopiuj do schowka
 
 
OShon 
Excel Expert



Zaproszone osoby: 383
Pomógł: 1619 razy
Posty: 8251
Wysłany: 03-01-2019, 10:21   

Jeśli chcesz skopiować dane z arkusza do arkusza, to raczej skoroszyt musi być otwarty.
_________________
Oskar Shon - MVP Office System/Development 11/19r, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Sprawdź promocje na polskie dodatki do MS Office w VBATools.pl
ID posta: 359536 Skopiuj do schowka
 
 
Mentor82 
świeżak


Pomógł: 1 raz
Posty: 5
Wysłany: 06-01-2019, 12:32   

Cześć,
Pierwsza sprawa - nie musisz otwierać workbooka jeżeli chcesz pobrać z niego danie z arkuszy. Zamiast metody workbooks("ścieżka").open należy użyć metody GetObject(pełna ścieżka do workbooka wraz z jego nazwą i rozszerzeniem)
Druga sprawa - niezależnie którą metodę wybierzesz tj. Open czy GetObject kod powinien być skonstruowany tak aby wykonać te operacje najpierw, wykonać wszystkie operacje na tym workbooku (np kopiowanie z wielu arkuszy) a następnie przejście do kolejnego workbooka, przy czym przy metodzie open trzeba uprzednio otwarty workbook zamknąć.

edycja Zbiniek:
Zainwestuj w klawiaturę - mam nadzieję, że to tylko ALT Ci się zacina.
Tekst bez polskich "ogonków" jest mniej czytelny i często bezużyteczny dla osób korzystających z http://www.excelforum.pl/search.htm (Korzystasz?)
POPRAWIŁEM ZA CIEBIE.
_________________
Pozdrawiam,
Seba

"Giva a man a fish and you feed him for a day. Teach a man to fish and you feed him for a lifetime."
  
ID posta: 359799 Skopiuj do schowka
 
 
OShon 
Excel Expert



Zaproszone osoby: 383
Pomógł: 1619 razy
Posty: 8251
Wysłany: 06-01-2019, 17:10   

No chyba nie do końca.
GetObject i CreateObject to polecenia wiązania odnoszą się do pliku do otwarcia w obecnej instancji lub pliku jaki zamierzasz otworzyć w nowej. Przypisanie do kilku zmiennych też jest możliwa a więc rozsądnie jest "zamknąć plik" ale nie jest to konieczne. Kwestia widoczności to drugorzędna sprawa, bo to tylko parametr aplikacji. Wyszukaj natomiast na forum funkcji getvalue i przetestuj ją. Niestety z moich doświadczeń wynika że dla większej ilości danych efektywniej jest jednak otworzyć plik niż dostawać się do niego bez otwierania.
_________________
Oskar Shon - MVP Office System/Development 11/19r, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Sprawdź promocje na polskie dodatki do MS Office w VBATools.pl
ID posta: 359813 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe