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: 69727 Skopiuj do schowka Makro kopiujące dane z jednego arkusza do innego arkusza
Autor Wiadomość
janosiknh 
Starszy Forumowicz


Wersja: Win Office 2010
Posty: 27
Wysłany: 05-01-2021, 23:48   Makro kopiujące dane z jednego arkusza do innego arkusza

Witam,
Potrzebuję pomocy przy napisaniu marka.
Tak więc do rzeczy.
Z programu, w którym wykonuję wyceny generuje mi się plik xls, który zapisuję pod nadaną przez siebie nazwą np. 001_G_2021.
Plik ten automatycznie się otwiera, stworzyłem w nim makro, które tworzy tabelę i przenosi potrzebne mi dane z z różnych komórek.
Jako, że tworzę takich plików kilkanaście dziennie, chciałbym podsumowywać wykonaną przez siebie pracę w innym (zbiorczym) excelu.

Mój plan jest taki aby po każdej wykonanej wycenie, wywoływać makro, które otworzy ten zbiorczy plik excel (np. zbiorczy.xmls) i do pierwszej wolnej komórki w kolumnie B wpisze nazwę pliku z którego wywołałem makro, do pierwszej wolnej komórki w kolumnie C skopiuje wartość z komórki np. C1 z pliku, z którego uruchomiłem makro, w pierwszej wolnej komórce w kolumnie F wygeneruje datę , w pierwszej wolnej komórce w kolumnie G wygeneruje aktualną godzinę, zapisze plik zbiorczy.xmls i go zamknie.

Nazwa pliku, z którego będzie uruchamiane makro będzie za każdym razem inna, będzie miała konstrukcję: numer_litera alfabetu_rok np. 001_G_2021, 057_B_2021 itd.

Niestety ale stawiam dopiero pierwsze kroki w VBA i działam na zasadzie nagrywania makr i ewentualnych prób zmian w tym co się nagrało.

Z góry dziękuję za pomoc.
W załączniku opis o co mniej więcej mi chodzi.

zbiorczy.xlsm
Pobierz Plik ściągnięto 14 raz(y) 9.84 KB

ID posta: 397706 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 3138 razy
Posty: 10388
Wysłany: 06-01-2021, 01:26   

Co prawda nie jest jasnym, czy w każdym pliku źródłowym będziesz miał kod do przenoszenia danych do skoroszytu zbiorczego, ale wydaje się to niewłaściwym podejściem. Poniższy kod możesz umieścić np. w skoroszycie makr osobistych (Personal.xlsb) i uruchamiać go gdy aktywnym jest właściwy arkusz w pliku, z którego chcesz skopiować dane. Przed uruchomieniem tego makra należy zadbać, by w Zbiorczy.xlsm usunąć nadmiarową liczbę porządkową. Makro samo wstawi właściwą liczbę, przy założeniu, że "tabela" rozpoczyna się od A2 (jak w załączonym przykładzie).
Kod:
Sub DoZbiorczego()
    Dim wksActv     As Worksheet
    Dim strWkbName  As String
    Dim wkbZb       As Workbook
    Dim lPosZb      As Long
    Dim v(1 To 5)   As Variant

    Set wksActv = ActiveSheet
    'nazwa pliku źródłowego
    strWkbName = wksActv.Parent.Name
    'tu założono, że plik źródłowy ma rozszerzenie 3 literowe (xls)
    strWkbName = Left(strWkbName, Len(strWkbName) - 4)

    v(1) = strWkbName 'nazwa pliku bez rozszerzenia
    With wksActv
        v(2) = .Range("C1").Value 'C1
        v(3) = .Range("D1").Value 'D1
    End With
    v(4) = Date 'Data
    v(5) = Time 'Godzina
   
    'spróbuj, może Zbiorczy jest otwarty
    On Error Resume Next
    Set wkbZb = Workbooks("Zbiorczy.xlsm")
    On Error GoTo 0
   
    If wkbZb Is Nothing Then
      'nie był otwarty, to go otwórz
      'założono, że Zbiorczy jest w tym samym folderze co źródłowy
      Set wkbZb = Workbooks.Open(Filename:=wksActv.Parent.Path & "\Zbiorczy.xlsm")
    End If
   
    With wkbZb
      With .Worksheets(1)
      'nr pierwszego wolnego wiersza
      lPosZb = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      'zapis danych w wierszu
      .Cells(lPosZb, "A").Value = lPosZb - 2 'Lp
      .Cells(lPosZb, "B").Resize(, 5).Value = v 'dane z arkusza źródłowego
      End With
      .Close True
    End With
   
End Sub

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 397713 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 797 razy
Posty: 4311
Wysłany: 06-01-2021, 13:05   

Kod:
'spróbuj, może Zbiorczy jest otwarty
    On Error Resume Next
    Set wkbZb = Workbooks("Zbiorczy.xlsm")

Czemu nie zastosowałeś jakiejś funkcji pt. "Czy_otwarty(plik)"?
(naprawdę chcę wiedzieć!).
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 397734 Skopiuj do schowka
 
 
janosiknh 
Starszy Forumowicz


Wersja: Win Office 2010
Posty: 27
Wysłany: 06-01-2021, 13:32   

Bardzo dziękuję za pomoc.
Tak jak pisałeś, kod będzie umieszczony w skoroszycie Personal.xlsb.

Mam jeszcze dwa pytania:

Plik "zbiorczy" nie będzie zapisany w tym samym folderze co plik, z którego będzie wywoływane makro. Będzie zapisany na dysku sieciowym, do którego ma dostęp kilka osób - w jaki sposób zmienić kod w makrze aby plik "zbiorczy" otwierał się z określonej lokalizacji?

Docelowo chciałbym rozbudowywać to makro, tabela w pliku "zbiorczy" będzie miała 12-15 kolumn, czy mógłbyś mi pokazać w jaki sposób dodawać do kodu linię:

Kopiuj wartość z komórki o adresie XY ze skoroszytu, z którego zostało wywołane makro do pierwszego wolnego wiersza w kolumnie X w pliku "zbiorczy".
ID posta: 397737 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 3138 razy
Posty: 10388
Wysłany: 06-01-2021, 19:52   

umiejead napisał/a:
Czemu nie zastosowałeś jakiejś funkcji pt. "Czy_otwarty(plik)"?
Z lenistwa. Gdyby janosiknh był moim klientem, to zanim pokazałbym mu makro, wypytał bym o parę szczegółów (m.in. o wielodostęp, o lokalizację i inne) i dostał by wtenczas to, czego oczekuje. Na forum nie mam obowiązku (i nikt go nie ma) wstawiania gotowców opracowanych od A do Z. Mamy wskazywać kierunki, a nie odwalać za kogoś robotę (co niestety często robimy). W kodzie zwróciłem uwagę na ewentualny problem otwartego wcześniej pliku. A co zrobi z tym użytkownik, to już jego sprawa.
janosiknh napisał/a:
Plik "zbiorczy"(...) będzie zapisany na dysku sieciowym, do którego ma dostęp kilka osób - w jaki sposób zmienić kod w makrze aby plik "zbiorczy" otwierał się z określonej lokalizacji?
No i się zaczyna. :-)
W makrze trzeba jednak sprawdzić, czy plik nie jest otwarty, by nie doprowadzić do sytuacji że otworzymy nową instancję tego pliku, ale w trybie tylko do odczytu. Mielibyśmy potem problem z jego zapisem.
"w jaki sposób zmienić kod" - jeżeli jest to stałe miejsce można pokusić się o zapis lokalizacji w kodzie. Na ogół preferuję wtenczas zastosowanie stałej na początku procedury (by potem nie szukać lokalizacji gdzieś dalej w procedurze; wiem, że znajdę ją na początku) i przypisanie do niej ścieżki udziału sieciowego. NIE zmapowanego dysku, nawet gdyby wszyscy mieli tę samą literę dysku zmapowanego (prawo Murphy-ego :-) ).

janosiknh napisał/a:
tabela w pliku "zbiorczy" będzie miała 12-15 kolumn, czy mógłbyś mi pokazać w jaki sposób dodawać do kodu linię...
Na chwilę obecną tabela w Zbiorczy zawiera 6 kolumn. W pierwszej wstawiana jest liczba porządkowa, której nie poznamy póki nie otworzymy tego pliku. Resztę danych mamy dostępne, bo albo pochodzą z aktywnego arkusza albo są "wyliczane" (nazwa_pliku, data, godzina). Zauważ, że zdefiniowałem tablicę jednowymiarową (Dim v(1 To 5)), która zawiera 5 elementów (6 kolumn danych - 1). Jeżeli rozbudujesz tabelę, to i powiększ rozmiar tablicy. Do elementów tej tablicy przypisz odpowiednie wartości, wszystko w takiej kolejności jak kolumny w pliku Zbiorczy.
Kod:
Sub DoZbiorczego_1()
    Dim wksActv     As Worksheet
    Dim strWkbName  As String
    Dim wkbZb       As Workbook
    Dim lPosZb      As Long
    Dim v(1 To 10)   As Variant
   
    Const sZBIORCZY As String = "\\server\folder\Zbiorczy.xlsm"
   
    Set wksActv = ActiveSheet
    'nazwa pliku źródłowego
    strWkbName = wksActv.Parent.Name
    'tu założono, że plik źródłowy ma rozszerzenie 3 literowe (xls)
    strWkbName = Left(strWkbName, Len(strWkbName) - 4)

    v(1) = strWkbName 'nazwa pliku bez rozszerzenia
    With wksActv
        v(2) = .Range("C1").Value 'C1
        v(3) = .Range("D1").Value 'D1
        v(4) = ...
        v(5) = ...
        v(6) = ...
        v(7) = ...
        v(8) = ...
    End With
    v(9) = Date 'Data
    v(10) = Time 'Godzina
   
    'sprawdź, czy plik Zbiorczy jest zamknięty
    If IsFileOpen(sZBIORCZY) Then
      MsgBox "Plik:" & vbLf & sZBIORCZY & vbLf & _
             "jest w tej chwili otwarty!" & String(2, vbLf) & _
             "Spróbuj później ponownie uruchomić makro.", vbExclamation
      Exit Sub
    End If
   
      'nie był otwarty, to go otwórz
      'założono, że Zbiorczy jest w udziale sieciowym
      Set wkbZb = Workbooks.Open(filename:=sZBIORCZY)
    End If
   
    With wkbZb
      With .Worksheets(1)
      'nr pierwszego wolnego wiersza
      lPosZb = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      'zapis danych w wierszu
      .Cells(lPosZb, "A").Value = lPosZb - 2 'Lp
      .Cells(lPosZb, "B").Resize(, UBound(v)).Value = v 'dane z arkusza źródłowego
      End With
      .Close True
    End With
   
End Sub


Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

            ' No error occurred.
            ' File is NOT already open by another user.
        Case 0
            IsFileOpen = False

            ' Error number for "Permission Denied."
            ' File is already opened by another user.
        Case 70
            IsFileOpen = True

            ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 397752 Skopiuj do schowka
 
 
janosiknh 
Starszy Forumowicz


Wersja: Win Office 2010
Posty: 27
Wysłany: 11-01-2021, 21:03   

Dziękuję bardzo za pomoc.
Na początku makro wyrzucało błąd, ale po usunięciu "End If" w linii

Set wkbZb = Workbooks.Open(filename:=sZBIORCZY)
End If

Wszystko zdaje się działać prawidłowo.
ID posta: 398101 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 797 razy
Posty: 4311
Wysłany: 11-01-2021, 23:19   

Brawo! Super że zrobiłeś to sam (po roku - ale jednak...) :mrgreen:

Naprawdę! :clap :-) .
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 398105 Skopiuj do schowka
 
 
janosiknh 
Starszy Forumowicz


Wersja: Win Office 2010
Posty: 27
Wysłany: 13-01-2021, 19:29   

umiejead napisał/a:
Brawo! Super że zrobiłeś to sam (po roku - ale jednak...) :mrgreen:

Naprawdę! :clap :-) .
.



Poprosiłem o pomoc, otrzymałem ją i podziękowałem.
Dzięki zrozumiałemu opisowi czegoś się nauczylem i będę mógł tę wiedzę wykorzystać w przyszłości.

Więc trochę nie rozumiem tej ironii i szyderstwa z Twojej strony.
ID posta: 398269 Skopiuj do schowka
 
 
J_B 
Excel Expert


Wersja: Win Office 2016
Pomógł: 541 razy
Posty: 1339
Wysłany: 13-01-2021, 20:00   

janosiknh napisał/a:
Więc trochę nie rozumiem tej ironii i szyderstwa z Twojej strony.

janosiknh na tym forum w przeważającej większości to ludzie kulturalni
A na zaczepki kulturalnych i mądrych "inaczej" nie zwracaj uwagi szkoda słów
Janusz
ID posta: 398271 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 797 razy
Posty: 4311
Wysłany: 14-01-2021, 16:44   

Tu nie było żadnego szyderstwa.

To były słowa uznania - że: kombinujesz / drążysz temat / chcesz jakoś sam zrozumieć "co i jak" - a nie czekasz na gotowe rozwiązanie.

Jeżeli moja wypowiedź mogła być dwojako zrozumiana - przepraszam.
Intencję miałem jak w akapicie wyżej.
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 398313 Skopiuj do schowka
 
 
janosiknh 
Starszy Forumowicz


Wersja: Win Office 2010
Posty: 27
Wysłany: 29-03-2021, 21:38   

Artik napisał/a:
umiejead napisał/a:
Czemu nie zastosowałeś jakiejś funkcji pt. "Czy_otwarty(plik)"?
Z lenistwa. Gdyby janosiknh był moim klientem, to zanim pokazałbym mu makro, wypytał bym o parę szczegółów (m.in. o wielodostęp, o lokalizację i inne) i dostał by wtenczas to, czego oczekuje. Na forum nie mam obowiązku (i nikt go nie ma) wstawiania gotowców opracowanych od A do Z. Mamy wskazywać kierunki, a nie odwalać za kogoś robotę (co niestety często robimy). W kodzie zwróciłem uwagę na ewentualny problem otwartego wcześniej pliku. A co zrobi z tym użytkownik, to już jego sprawa.
janosiknh napisał/a:
Plik "zbiorczy"(...) będzie zapisany na dysku sieciowym, do którego ma dostęp kilka osób - w jaki sposób zmienić kod w makrze aby plik "zbiorczy" otwierał się z określonej lokalizacji?
No i się zaczyna. :-)
W makrze trzeba jednak sprawdzić, czy plik nie jest otwarty, by nie doprowadzić do sytuacji że otworzymy nową instancję tego pliku, ale w trybie tylko do odczytu. Mielibyśmy potem problem z jego zapisem.
"w jaki sposób zmienić kod" - jeżeli jest to stałe miejsce można pokusić się o zapis lokalizacji w kodzie. Na ogół preferuję wtenczas zastosowanie stałej na początku procedury (by potem nie szukać lokalizacji gdzieś dalej w procedurze; wiem, że znajdę ją na początku) i przypisanie do niej ścieżki udziału sieciowego. NIE zmapowanego dysku, nawet gdyby wszyscy mieli tę samą literę dysku zmapowanego (prawo Murphy-ego :-) ).

janosiknh napisał/a:
tabela w pliku "zbiorczy" będzie miała 12-15 kolumn, czy mógłbyś mi pokazać w jaki sposób dodawać do kodu linię...
Na chwilę obecną tabela w Zbiorczy zawiera 6 kolumn. W pierwszej wstawiana jest liczba porządkowa, której nie poznamy póki nie otworzymy tego pliku. Resztę danych mamy dostępne, bo albo pochodzą z aktywnego arkusza albo są "wyliczane" (nazwa_pliku, data, godzina). Zauważ, że zdefiniowałem tablicę jednowymiarową (Dim v(1 To 5)), która zawiera 5 elementów (6 kolumn danych - 1). Jeżeli rozbudujesz tabelę, to i powiększ rozmiar tablicy. Do elementów tej tablicy przypisz odpowiednie wartości, wszystko w takiej kolejności jak kolumny w pliku Zbiorczy.
Kod:
Sub DoZbiorczego_1()
    Dim wksActv     As Worksheet
    Dim strWkbName  As String
    Dim wkbZb       As Workbook
    Dim lPosZb      As Long
    Dim v(1 To 10)   As Variant
   
    Const sZBIORCZY As String = "\\server\folder\Zbiorczy.xlsm"
   
    Set wksActv = ActiveSheet
    'nazwa pliku źródłowego
    strWkbName = wksActv.Parent.Name
    'tu założono, że plik źródłowy ma rozszerzenie 3 literowe (xls)
    strWkbName = Left(strWkbName, Len(strWkbName) - 4)

    v(1) = strWkbName 'nazwa pliku bez rozszerzenia
    With wksActv
        v(2) = .Range("C1").Value 'C1
        v(3) = .Range("D1").Value 'D1
        v(4) = ...
        v(5) = ...
        v(6) = ...
        v(7) = ...
        v(8) = ...
    End With
    v(9) = Date 'Data
    v(10) = Time 'Godzina
   
    'sprawdź, czy plik Zbiorczy jest zamknięty
    If IsFileOpen(sZBIORCZY) Then
      MsgBox "Plik:" & vbLf & sZBIORCZY & vbLf & _
             "jest w tej chwili otwarty!" & String(2, vbLf) & _
             "Spróbuj później ponownie uruchomić makro.", vbExclamation
      Exit Sub
    End If
   
      'nie był otwarty, to go otwórz
      'założono, że Zbiorczy jest w udziale sieciowym
      Set wkbZb = Workbooks.Open(filename:=sZBIORCZY)
    End If
   
    With wkbZb
      With .Worksheets(1)
      'nr pierwszego wolnego wiersza
      lPosZb = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      'zapis danych w wierszu
      .Cells(lPosZb, "A").Value = lPosZb - 2 'Lp
      .Cells(lPosZb, "B").Resize(, UBound(v)).Value = v 'dane z arkusza źródłowego
      End With
      .Close True
    End With
   
End Sub


Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

            ' No error occurred.
            ' File is NOT already open by another user.
        Case 0
            IsFileOpen = False

            ' Error number for "Permission Denied."
            ' File is already opened by another user.
        Case 70
            IsFileOpen = True

            ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

Artik


Rozwiązanie spisuje się znakomicie - jeszcze raz bardzo dziękuję za poświęcony czas.

Chciałbym jeszcze bardziej zautomatyzować pewne czynności, i bardzo pomogłoby mi w tym nieco zmodyfikowane makro, które stworzył Artik.
Zasada działania byłaby niemal identyczna.

Z programu do obliczeń, z którego korzystam, generowany jest plik excel z 4-6 arkuszami, potrzebne dane zawsze znajdują się w arkuszu "Rozliczenie wewnętrzne".
Chciałbym sprawdzić czy w arkuszu rozliczenie wewnętrzne znajdują się profile o konkretnych nazwach, dajmy na to: MDS050, MDS051, MDS053, EF261.
Jeżeli taki profil się znajduje, to wartość z kolumny ilość przy danym profilu, zostanie skopiowana do pliku znajdującego się na dysku sieciowym o nazwie "Zestawienie" (wartość MDS050 do kolumny MDS050, MDS051 do kolumny MDS051 itd.).
Jeżeli danego profilu nie ma w arkuszu "Rozliczenie wewnętrzne" to wstawiona zostanie wartość 0.
W kolumnie Lp zostanie dodana liczba porządkowa, a w kolumnie nr zlecenia zostanie wpisana nazwa skoroszytu, z którego wywoływane będzie makro.
W załączniku poglądowe pliki.

642_2020.XLS
Pobierz Plik ściągnięto 4 raz(y) 446.5 KB

Zestawienie.xlsx
Pobierz Plik ściągnięto 4 raz(y) 9.51 KB

ID posta: 402937 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