napisał: pil
postów: 154
 umieszczony:
5 kwietnia 2005
09:51
|
|
procedura otwiera kolejne pliki excela i wstawia zawartość "Arkusz1" do kolejnych wierszy bieżącego arkusza:
Option Explicit
Public Sub LadujPliki()
Dim skoroszyt As Workbook
Dim strPath, strFileName As String
Dim strDalej As String
Dim wiersz, kolumna, plik, nastepnaKomorka As Integer
strDalej = vbYes
plik = 1
Do While (strDalej = vbYes)
'pętla będzie działała dopóki użytkownik nie wybierze NIE w msgbox
strPath = ThisWorkbook.Path 'sciezka do pliku, oba pliki muszą znajdować się w tym samym katalogu
strFileName = InputBox("Podaj nazwę pliku źródłowego (bez rozszerzenia): ") 'nazwa pliku od użytkownika
strFileName = strFileName & ".xls" 'dodanie rozszerzenia do nazwy pliku
strPath = strPath & "\" & strFileName 'nazwa pliku ze sciezka
Set skoroszyt = Workbooks.Open(strPath) 'otwarcie pliku
wiersz = 1 'wartości startowe liczników
nastepnaKomorka = 1 'zmienna iteruje się przy każdym wpisie do arkusza
Do While (skoroszyt.Worksheets("Arkusz1").Cells(wiersz, 1).Value <> "") 'czy pierwsza komóra w aktywnym wierszu jest wypełniona
kolumna = 1
'pętla działa dopóki nie napotka na pustą komórkę
Do While (skoroszyt.Worksheets("Arkusz1").Cells(wiersz, kolumna).Value <> "")
ThisWorkbook.Worksheets("Arkusz1").Cells(plik, nastepnaKomorka).Value = _
skoroszyt.Worksheets("Arkusz1").Cells(wiersz, kolumna).Value
nastepnaKomorka = nastepnaKomorka + 1
kolumna = kolumna + 1
Loop
wiersz = wiersz + 1
Loop
plik = plik + 1
skoroszyt.Close
Set skoroszyt = Nothing
strDalej = MsgBox("Następny plik ?", vbYesNo)
Loop
End Sub |
|
|
napisał: agniesia
postów: 1
umieszczony:
1 kwietnia 2005
13:22
|
|
| Mam zrobić makro kopiujące dane z wielu plików do jednej tabeli. Makro otwiera już kolejne pliki, mam jednak problem z umieszczaniem danych w tabeli. Jak zrobić, by dane kopiowały się do jednej kolumny, lecz do kolejnych wierszy? Narazie wszystkie kopiują się do tej samej komórki :( Czy można dane umieszczone w kolumnie szybko zamienić wiersz? |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
