Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek dla www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

[VBA] kopiowanie z kilku plików do jednego arkusza

25 Lis 2010 13:15 5143 6
  • Poziom 9  
    Koledzy posiadam takie makro kopiujące z plików do jednego arkusza.
    Wszystko działa, problem polega na tym że zaszyte mam gdzie makro ma zaczynać kopiowanie i zazwyczaj kończy na pierwszy wolnym polu. Z tego powodu czasem omija dane jak komórka jest pusta.

    Czy ktoś mógłby zasugerować jak powinno wyglądać makro kopiujące cały arkusz?

    Code:
    Option Explicit
    

    Sub odczytPlikuZKatalogu()
    Dim docelowy    As Worksheet
    Dim odczytany   As Workbook
    Dim sciezka     As String
    Dim nazwa_pliku As String
    Dim ileA        As Long

    Application.ScreenUpdating = False
    Const Odstep = 1

    Set docelowy = ThisWorkbook.Worksheets(1)
    sciezka = ThisWorkbook.Path & "\test\"
    nazwa_pliku = Dir(sciezka & "*.xls")
    With docelowy
        Do While nazwa_pliku <> ""
            ileA = .Cells(.Rows.Count, "A").End(xlUp).Row + 2
            If .Range("A1") = "" Then ileA = 1
           
            Set odczytany = Workbooks.Open(sciezka & nazwa_pliku)
            odczytany.Worksheets("Dokument").Cells(24, 1).CurrentRegion.Copy .Cells(ileA, "A")
            odczytany.Close
            nazwa_pliku = Dir
        Loop
    End With
    Application.ScreenUpdating = True

    End Sub


    Dziekuje za pomoc
  • Poziom 28  
    Cytat:
    zaszyte mam gdzie makro ma zaczynać kopiowanie
    jest w wierszu
    Code:
    odczytany.Worksheets("Dokument").Cells(24, 1).CurrentRegion.Copy .Cells(ileA, "A") 

    a
    Cytat:
    kończy na pierwszy wolnym polu
    tu
    Code:
    ileA = .Cells(.Rows.Count, "A").End(xlUp).Row + 2 
  • Poziom 9  
    to to wiem sam :) naotmiast mimo usilnych starań nie potrafie tego zamienić na cały plik
  • Poziom 40  
    vrd napisał:
    ...jak powinno wyglądać makro kopiujące cały arkusz?


    vrd napisał:
    ...nie potrafie tego zamienić na cały plik


    Arkusz - część składowa skoroszytu. W skoroszycie może być wiele arkuszy.
    Plik zapewne w tym przypadku rozumiany jako skoroszyt. np Zeszyt1.xls

    Przepraszam że się wtrącam ale zdecyduj się co chcesz kopiować.
    Myślę że chodzi o arkusz ale...


    Zapis kopiujący cały arkusz to:

    Code:
    odczytany.Worksheets("Dokument").Cells.Copy


    jednak w twojej formule jest problem bo ona chce kopiować kolejne dane do już istniejących a gdy kopiujesz cały arkusz to razem z wszystkimi komórkami a wtedy nastąpi błąd rozmiarów.

    Jeżeli chcesz skopiować cały arkusz (w cały arkusz) spróbuj zmienić pętlę:

    Code:
    Do While nazwa_pliku <> "" 
    
            Set odczytany = Workbooks.Open(sciezka & nazwa_pliku)
            odczytany.Worksheets("Dokument").Cells.Copy .Cells
            odczytany.Close
            nazwa_pliku = Dir
        Loop


    Z tym że nie sprawdzałem do końca tego rozwiązania ale myślę że zadziała.
  • Poziom 9  
    Tak chodzi o arkusz.
    Niestety Twoje rozwiązanie nie działa. Pojawia się informacja o przechowywaniu informacji w schowku po czym excel sie zamyka.
  • Poziom 40  
    Spójrz jeszcze raz trochę poprawiłem (dokładnie o [spacja].Cells)
    Czyli linia kopiująca to
    Code:
    odczytany.Worksheets("Dokument").Cells.Copy .Cells 
  • Poziom 11  
    to żeby to zadziałało to jak powinno wyglądać bo u mnie nie chodzi