Kopiowanie przyrostowe danych z innych skoroszytów
by vbatools on Feb.16, 2012, under Excel, Porady
Kopiowanie przyrostowe często wpędza w zakłopotanie. Jak wykonać działanie szybko i bez konieczności szukania, zaznaczania zakresów, przechodzenia pomiędzy skoroszytami etc.
Poniżej przedstawiam drobny kod, który pokazuje jak otworzyć plik, zadeklarować obszar, odnaleźć w docelowym arkuszu ostatnią wypełnioną komórkę i do następnej import danych z zakresu pliku źródłowego. Zakładamy w nim iż plik źródłowy ma jeden lub pierwszy arkusz z danymi jakie nas interesują. Drugim założeniem jest iż kopiujemy wszystkie dane z zakresu kolumny A (może być zakres wielu kolumn).
Sub open_copy_paste_n_close() 'MVP OShon from VBATools.pl Const nazwapliku$ = "c:\Temp\1.xlsx" 'Nazwa pliku do otwarcia Dim thiswkb As Workbook, wkb As Workbook, min_row& Set thiswkb = ActiveWorkbook Call BlockEvScreenCalc(False, "Import danych...") Workbooks.Open Filename:=nazwapliku Set wkb = ActiveWorkbook Dim rng1 As Range, rng2 As Range With wkb.Sheets(1) Set rng1 = .Range("a1:a" & .Cells(Rows.Count, "a").End(xlUp).Row) End With With thiswkb.Sheets("Arkusz1") 'arkusz docelowy min_row = .Cells(Rows.Count, "a").End(xlUp).Row If Len(.Range("a1")) > 0 Then min_row = min_row + 1 'jeśli mamy nagłówek Set rng2 = .Range("a" & min_row) End With rng1.Copy rng2 koniec: On Error Resume Next wkb.Close False Set rng1 = Nothing Set rng2 = Nothing Set thiswkb = Nothing Set wkb = Nothing Call BlockEvScreenCalc(True) Exit Sub blad: Call BlockEvScreenCalc(True) MsgBox "Error: " & Err.Number & vbCr & Err.Description, vbCritical, "VBATools.pl" Resume koniec End Sub Public Sub BlockEvScreenCalc(Optional ByVal bWlacz As Boolean, Optional Status As String) On Error Resume Next With Application If bWlacz Then .EnableEvents = True .Calculation = xlCalculationAutomatic .StatusBar = "" .ScreenUpdating = True .Cursor = xlDefault Else .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False .StatusBar = Status .Cursor = xlWait End If End With End Sub
(c) Shon Oskar – www.VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.