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: 63711 Skopiuj do schowka Kopiowanie danych między plikami
Autor Wiadomość
crimson
forumowicz


Posty: 10
Wysłany: 07-01-2019, 11:41   Kopiowanie danych między plikami

Cześć,
Próbuję napisać kod, który wykonałby następującą operację:

Stan obecny:
1. Mam dwa pliki source.xlsm oraz goal.xlsm
2. Plik source.xlsm zawiera 215 arkuszy, wszystkie identyczne, różniące się jedynie danymi w zakresie komórek B62:C10000
3. Plik goal.xlsm, zawierający arkusz "master_corrected"

Co chcę zrobić:
1. W pliku goal.xlms skopiować arkusz master_corrected na koniec
2. Z pliku source.xlsm, po kolei z każdego arkusza, przekopiować wartość z zakresu B62:C10000 i wkleić do komórki B40, do pliku goal.xlsm, do utworzonej za każdym razem nowej kopii arkusza master_corrected.

Do tej pory przygotowałem taki kod, ale niestety zapycha ram i nie wykonuje operacji prawidłowo. Wkleja wciąż te same wartości i wysypuje się po utworzeniu 124 kopii master_corrected.
Kod:
Function ImportData()
Dim x As Long
Dim i As Integer
Dim y As Workbook
Dim z As Workbook

i = Worksheets.Count

For x = 1 To i
    Application.ScreenUpdating = False
    Set y = Workbooks("goal")
    Set z = Workbooks("source.xlsm")
    y.Sheets("Master_Corrected").Copy , Sheets(Sheets.Count)
    z.Sheets(x).Range("B62:C10000").Copy
    y.Sheets(Sheets.Count).Range("B40").PasteSpecial
    x = x + 1
Next x

End Function

Proszę o radę, jak zmodyfikować kod, aby "zrobił" to co chcę. Jeśli opis jest niezrozumiały, postaram sie opisać problem bardziej logicznie.

Z góry dziękuję za pomoc
Pozdrawiam
ID posta: 359894 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 339 razy
Posty: 1805
Wysłany: 07-01-2019, 11:49   

A nie możesz załączyć plików?
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
I dbajmy - proszę - o poprawną polszczyznę.
ID posta: 359895 Skopiuj do schowka
 
 
crimson
forumowicz


Posty: 10
Wysłany: 07-01-2019, 11:57   

Niestety pliki to wewnętrzne narzędzia, których nie moge udostępniać. Oba pliki to dwie wersje narzędzia v1 i v2. Mam za zadanie sprawdzenie czy nowa wersja działa prawidłowo i muszę to zrobić na "żywych" danych. Czyli przenieść dane ze starej wersji do nowej, ale nie chcę 215 razy z palca tworzyć kopii master_corrected i przenosić danych między plikami.
ID posta: 359897 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 339 razy
Posty: 1805
Wysłany: 07-01-2019, 12:22   

Czy w arkuszu master_corrected są jakieś dane?
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
I dbajmy - proszę - o poprawną polszczyznę.
ID posta: 359900 Skopiuj do schowka
 
 
Tajan


Pomógł: 4363 razy
Posty: 9692
Wysłany: 07-01-2019, 12:23   

Trochę uporządkowałem i co nieco poprawiłem. Przetestuj:
Kod:
Sub ImportData()
Dim x As Long
Dim i As Long
Dim y As Workbook
Dim z As Workbook

Application.ScreenUpdating = False

Set y = Workbooks("goal")
Set z = Workbooks("source.xlsm")

i = z.Worksheets.Count

For x = 1 To i
    y.Sheets("Master_Corrected").Copy , y.Sheets(y.Sheets.Count)
    z.Sheets(x).Range("B62:C10000").Copy
    y.Sheets(y.Sheets.Count).Range("B40").PasteSpecial
Next x

Application.CutCopyMode = False

End Sub
ID posta: 359901 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 339 razy
Posty: 1805
Wysłany: 07-01-2019, 13:28   

Zmieniłem sposób kopiowania - co miało dać "PasteSpecial"?
Kod:
Option Explicit

Sub ImportData()
Dim i As Long, lark As Long
Dim wbS As Workbook, wbG As Workbook
Dim ws As Worksheet

On Error Resume Next

Set wbG = ThisWorkbook
Set wbS = Workbooks("source.xlsm")
lark = wbS.Worksheets.Count

Application.ScreenUpdating = False

Application.DisplayAlerts = False
For Each ws In wbG.Worksheets
    If ws.Name <> "Master_Corrected" Then ws.Delete
Next ws
Application.DisplayAlerts = True

For i = 1 To lark
    wbG.Sheets("Master_Corrected").Copy , wbG.Sheets(wbG.Sheets.Count)
    wbS.Sheets(i).Range("B62:C10000").Copy Destination:= _
        wbG.Sheets(wbG.Sheets.Count).Range("B40")
Next i

Application.ScreenUpdating = True

End Sub
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
I dbajmy - proszę - o poprawną polszczyznę.
ID posta: 359905 Skopiuj do schowka
 
 
crimson
forumowicz


Posty: 10
Wysłany: 09-01-2019, 09:17   

Skorzystałem z uporządkowanego kodu, przygotowanego przez Tajan. Całość zadziałała zgodnie z oczekiwaniami. Jedyną bolączką było to, że po utworzeniu i przekopiowaniu danych z około 140 arkuszy, pojawiał się błąd limitu pamięci MS Office, z propozycją zmiany na wersję 64bit i dodaniem ramu. Żeby tego uniknąć jedyne co musiałem zmienić, to liczbę iteracji i po prostu wykonać operację kilka razy, zamiast jednego przejścia.

Jeszcze raz dziękuję wszystkim za pomoc.
ID posta: 360056 Skopiuj do schowka
 
 
Tajan


Pomógł: 4363 razy
Posty: 9692
Wysłany: 09-01-2019, 10:21   

Microsoft na podobny problem proponuje okresowo zapisywać i zamykać plik lub wstawiać nowy arkusz z szablonu zamiast kopiować istniejący: https://support.microsoft.com/pl-pl/help/210684/copying-worksheet-programmatically-causes-run-time-error-1004-in-excel
ID posta: 360064 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