Dobry wieczór, Nie znam się na SolidWorks, ale w kodzie VBA widzę przynajmniej dwa błędy: pierwszy w połączeniu Range("Q5...BJ5").Selection.Copy Powinno być rozbite na dwie instrukcje Range("Q5...BJ5").Select Selection.Copy Można też pominąć selekcję i pozostawić tylko: Range("Q5...BJ5").Copy Drugi błąd: Active.Worksheet.Paste Po pierwsze ta instrukcja...
A dlaczego nie dać szansy Excelowi, tylko go wyręczać? [syntax=vbscript]Sub Zapis_do_CSV() ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\baza test2.csv", _ FileFormat:= xlCSV, CreateBackup:=False, Local:=True End Sub[/syntax] Nie zwróciłem uwagi, że to ma być bez pierwszego wiersza, ale ten zawsze można usunąć później. Najważniejsze, żeby Excel...
Po zakończeniu kopiowania nie jest zwracania na pierwszy arkusz
Poprawiłem błąd.
[syntax=vbscript]Sheets("2").Range("C1")... = vbRed[/syntax]
1. Wyrzuć "górne" r=r+1, ustaw (u góry) r=2 jeśli... sam już nie wiem. Wypróbuj. 2. Nie ta metoda. Musiałbyś copy-paste i wybierając (select) wiersz (zakres) docelowy. P.S. Zmykam. Dobranoc ;)
[syntax=vbscript]For y = 1 To ile - 1[/syntax]
Wyszło mi coś takiego[syntax=vb]Sub Pobierz() Dim nazwa As String Dim ark As Worksheet Dim wrs As Long, j As Integer, i As Long nazwa = "Arkusz2" 'nazwa arkusza docelowego 'tutaj 2 dla porównania z 1 ThisWorkbook.Activate 'gdyby nie był Sheets(nazwa).Range("A2:H65536").ClearCo... 'czyścimy wrs = 2 '1-szy wiersz docelowy j = 3 '1-sza kolumna źródłowa...
[syntax=vb]wiersz = 6 Sheets(1).Activate While Cells(wiersz, 1) <> "" Cells(wiersz, 2).Copy Sheets(Cells(wiersz, 1).Text).Range("C8") wiersz = wiersz + 1 Wend [/syntax]
[syntax=vb]Private Sub CommandButton1_Click() Zeszyt = ActiveWorkbook.Name Workbooks.Open Filename:="C:\Users\mm\Desktop\Nowy_fold... Range("A:A").Copy ThisWorkbook.Activate Sheets("Arkusz2").Activate Range("B1").Select ActiveSheet.Paste Workbooks("wsad.xlsx").Close Windows(Zeszyt).Activate End Sub[/syntax]
[syntax=vbscript]Sub Szukanie() NazwaPliku = UCase("SzukanyPlik.XLSX") Set Liczydlo = Sheets("SzukanyPlik") Application.ScreenUpdating = False Do While SzukanyPlik <> NazwaPliku p = Application.GetOpenFilename(FileFilter:=... files, *.xlsx", Title:="Find SzukanyPlik", MultiSelect:=False) SzukanyPlik = UCase(Mid(p, InStrRev(p, "\") + 1)) If...
[syntax=vbscript]Sub NowaKolumna() nk = Cells(60, Columns.Count).End(xlToLeft).Column + 1 Range("H60:H80").Copy Cells(60, nk) Application.CutCopyMode = False End Sub [/syntax]
Makro poniżej przesuwa nazwiska w prawo o wartość numeru grupy+1, a następnie usuwa puste komórki w obszarze danych. Nazwiska nie są posortowane. Jeżeli jest potrzeba. sortowania to na początku makra dopisać sortowanie.[syntax=vbscript]Sub Przepisz_Nazwiska() Dim Tab_Opis As Variant With ActiveSheet Tab_Opis = Array("Grupa 1", "Grupa 2", "Grupa 3",...
Ma ktoś jakiś pomysł? Teraz chyba będzie jasne :) https://obrazki.elektroda.pl/1782827600_...
:arrow: Do autora: Dobrze podstawiłeś to makro? W załączeniu przykład z działającym makrem kolegi adamas_nt Poprawiłem tylko to, że nie liczy dla 100 wierszy tylko dla wszystkich wierszy w kolumnie A zeszytu1. Dodane po czasie ----------------------------- Zmieniłeś treść wiadomości więc moja uwaga nie ma już uzasadnienia, niemniej pozostawiam przykład...
Spróbuj takiego makra. [syntax=vbscript] Sub Kopiowanie() Dim arkA As Worksheet, arkB As Worksheet, arkZest As Worksheet Dim OstA&, OstB&, GdzieWkleic&, PierwszyWiersz%, IleKolumn% Set arkA = ThisWorkbook.Worksheets("aaa") Set arkB = ThisWorkbook.Worksheets("bbb") Set arkZest = ThisWorkbook.Worksheets("Zestawienie") OstA = arkA.Cells(Rows.Count,...
[syntax=vbscript]Next a.AutoFilterMode = False End Sub [/syntax]
Jeżeli pola są oddzielone spację, wystarczy taka modyfikacja pętli: [syntax=vb]Do While Not EOF(1) Line Input #1, TextLine If Left(TextLine, 13) = "121401_2.0011" Then arr = Split(TextLine, " ") wsdane.Cells(i, 1).Value = arr(0) wsdane.Cells(i, 2).Value = arr(1) wsdane.Cells(i, 3).Value = arr(2) wsdane.Cells(i, 4).Value = arr(3) wsdane.Cells(i, 5).Value...
Wystarczy wszystko przeciągnąć/skopiować ... Mam nadzieję, że właściwie podałeś treść zadania, najlepiej przytocz je całe.
Rozumiem, że arkusz z danymi do kopiowania jest w osobnym pliku.
Jeśli dobrze rozumiem, to tak:
Nie znalazłem w internecie opisu makr z tą zaletą, że można wpisać w makro dowolną funkcję np. ową Wyszukaj.Pionowo [url=https://www.google.com/search?q=vba...
Witam Jeśli chcesz tylko wartości z innych arkuszy, pomoże to makro. wynik w arkuszu 1. Wszystkie arkusze muszą być nagłówek ID, bo nie wiem, w którym część arkusza są dane
To ja też zmodyfikuję.;) [syntax=vbscript]Sub Makro1() ow = Cells(Rows.Count, "H").End(xlUp).Row For x = 1 To ow If Cells(x, 8) = 0 Then Cells(x, 10).Cut Cells(x, 15) Next End Sub[/syntax]
W przyszłości nie trzeba pisać skoroszyt zamiast arkusz(z określonymi numerami) Skoroszyt to jest plik(w każdym razie tak to było do tej pory). Ponieważ nie wiadomo, czy te same struktury arkuszy, liczbę wierszy i kolumn, kopiowanie, możesz zrobić tak: [syntax=vb] Sub kopie() 'makro w pliku(skoroszycie) A, plik B jest otwarty 'kolejne 3 linie dopasuj...
Brakuje chyba jeszcze jednej pętli zmieniającej kod sklepu. Hmm, raczej: na pewno ;) Spróbuj[syntax=vb]Sub asd() Dim wiersz, nr, ilosc As Integer Dim ostWrs As Long, w As Long, ile As Integer ostWrs = Range("B65536").End(xlUp).Row wiersz = 1 Range("C1:D1500").Clear For w = 1 To ostWrs nr = Cells(w, 1) ilosc = Cells(w, 2) For ile = 1 To ilosc Cells(wiersz,...
otwierał nowego Excela nowe wystąpienie programu Excel, lub nowy skoroszyt? Myslim ze skoroszyt:[syntax=vb]Sub kopie20() Dim nw As Worksheet Dim my As Range Set my = Workbooks("Truck.xls").Sheets("Aero") s = 0: k = 1 For n = 1 To my.Cells(65536, "P").End(xlUp).Row s = s + my.Cells(n, "p") If s + my.Cells(n + 1, "p") > 20 Or my.Cells(n + 1, "p") = ""...
Jeśli adresy w podglądzie są prawidłowe, to podstaw kopiowanie. [syntax=vbscript]Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("Arkusz2") wdst = 3 With ws For w = 2 To 812 Step 6 For k = 11 To 24 Step 3 'podgl = Range(Cells(w, k), Cells(w, k + 2)).Address(0, 0) & " kopiuj do " & Cells(wdst, 8).Address(0, 0) .Range(.Cells(w, k), .Cells(w, k +...
Brak załącznika to poważny mankament! Nie wiadomo, jakie dane są w kolumnie "O". W kodzie PRL jest sprawdzany warunek: [syntax=vbscript]Sheets(x).Cells(y, "O") >= -30[/syntax]Otóż warunek ten spełniają nie tylko liczby >= -30, ale również puste komórki, dowolne teksty, w tym teksty puste, wartości logiczne. A jeśli w komórce jest wartość błędu, to program...
Wygląda na to że bez zmian dla przykładu jeden wiersz a arkuszu Arka w którym sformatowałem ceny kolorem czerwonym: Sam chciałeś W nagranym przeze mnie makrze takie wklejanie daje taką linijkę kodu: Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats Niestety nie wiem czy można ja dopisać do Twojego makra. Niestety nie potrafię z kodu wychwycić...
A nie możesz wyniki przenieść na drugi arkusz? Wtedy tylko zmieniasz formułę: =LEWY(Arkusz1!A1;2) =PRAWY(Arkusz1!A1;DŁ(Arkusz1!A1&... Czy musisz na tym samym arkuszu kategorycznie pozostać? EDIT: Zrobiłem specjalnie dla Ciebie makro ;) [syntax=vb]Sub Prostokąt1_Kliknięcie() koniec = Range("A1").End(xlDown).Row Application.ScreenUpdating...
Bo jesli dodasz dwie kolumny do każdego działu, to w makrze Kopiuj() musisz poprawić krok wyszukiwania z 4 na 6: [syntax=vb]For kol = 1 To 255 Step 6[/syntax] i, ewentualnie, tam gdzie teraz kopiujesz komórki od C do E zwiększyć od C do G i kol+5: [syntax=vb]Worksheets("Arkusz1").Range("... & Selection.Row & ":G" & Selection.Row).Copy .Range(.Cells(wiersz,...
[syntax=vb] Sub SzukajCiagu() Dim x As Long, y As Long, z As Long, SzukaneSlowo As String x = 1 z = 1 Sheets("PrzeszukiwanyArkusz").Select While Cells(x, 1) <> "" y = 1 While Sheets("ListaSlow").Cells(y, 1) <> "" SzukaneSlowo = Sheets("ListaSlow").Cells(y, 1) If InStr(1, Cells(x, 5), SzukaneSlowo) > 0 Or InStr(1, Cells(x, 6), SzukaneSlowo)...
Dodaj Swoja sciezka w Dir, jak w post #1 Dodano po 4 lub przed wlanczeniem makra zrob "Plik - Otworz" wejdz w folder z plikami - "Esc"(Odmiana)
Kolego ten twój cały kod można skrócić do [syntax=vbnet]With Sheets("Arkusz1") .Columns("C:C").AdvancedFilter Action:=xlFilterInPlace, Unique:=True .Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellT... .Range("E19") .ShowAllData .Range("E19").End(xlDown).Offset(1).Sele... End With[/syntax] ps. jak co to na dziś już...
[syntax=vbscript] Dim Tmp As String On Error Resume Next For Each cell In Selection If Left(cell, 1) = "M" Then Tmp = "<nie znaleziono>" Tmp = Application.WorksheetFunction.VLookup(ce... Sheets("config").Range("A:B"), 2, False) If Len(Tmp) = 0 Then Tmp = "<brak nazwy>" cell.Offset(0, 4) = Tmp End If Next On Error GoTo 0[/syntax]
Spróbuj to [syntax=vb] Sub Porzadkuj() x = InputBox("Podaj datu", "Data przyporziadkowania", Date) If Not IsDate(x) Then Exit Sub x = DateValue(x) Dim nazwy As Range, d As Range With Sheets("pivot") Set nazwy = .Rows(3) Set d = .Cells.Find(x, LookIn:=xlValues) If d Is Nothing Then Exit Sub Set d = d.EntireRow.Cells For Each sh In ThisWorkbook.Sheets...
Przetestuj załączone rozwiązanie. Przed uruchomieniem należy: - Plik csv nazwać: "dane.csv" - Załączony skoroszyt zapisać w folderze, w którym znajduje się plik "dane.csv" U mnie cała procedura wykonuje się ok. 1 min. pozdrawiam andie
No tak. Mój błąd, bo powinno być w innej kolejności. Sorry, ale dzisiaj sobota ;) Coś tam (w załączniku) kopiuje. Przeanalizuj, dostosuj do własnych potrzeb.
Pisać programu nie da się metodą kopiuj/wklej. Edytor VB zgłosił błąd i napisał w czym problem.
Przyczyną błędu jest tylko to, co napisał adams_nt : powinna być deklaracja typu jak poniżej: Ewentualnie program mógł by sprawdzić czy akrusz B jest otwarty, jeżeli jest nie otwierać go ponownie a jeżeli jest zamknięty otworzyć go. Założyłeś, że Twoje makro będzie kopiować z pliku B.xls aktualnie zaznaczony wiersz - ono nie otwiera pliku [ponownie]....
OK. Teraz mam pilne zadanie, w godzinach wieczornych coś do rozwiązania. ... Tu to jest [syntax=vb]Sub copyNumKs() Dim bd As Range, bs As Range, r& With Sheets(1) Set bd = .Cells(1, 5).Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 1) End With With Sheets("wydruk") Set bs = .Cells(1, 2).Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 2) End With For r = 2...
Witaj. Zakładając, że oryginalne dane na pierwszym arkuszu, a wynik na drugi: [syntax=vb]Sub upraw() Dim bsk As Range, bsr As Range Dim rb&, rd&, cd&, cm& Set bsk = ThisWorkbook.Sheets(1).Columns(1).Cells Set bsr = ThisWorkbook.Sheets(1).Range("B:J").Rows rb = 2: rd = 2 With ThisWorkbook.Sheets(2) bsk(1).Copy .Cells(1, 1): bsr(1).Copy...
Sprobuj takie makro - jest bardzo proste zaklada ze uruchamiasz je z arkusza Dane i ze tabelka w arkuszu Dane jest w tym samym miejscu co dales w przykladzie Sub test() Dim DaneX, DaneY, SpisX As Integer DaneX = 2 DaneY = 2 SpisX = 10 Do While Cells(DaneX, 1).Value <> "" Do While Cells(1, DaneY).Value <> "" If Val(Cells(DaneX, DaneY).Value)...
Oto projekt. Początkowo Pan otworzyć i odczytać z makrami.(na otwarcie i zamknięcie książki) i poprawi stałych (bo nie mogę odgadnąć nazwy plików). Następnie skopiuj makra do prawdziwych plików Interesuje mnie jak długo potrwa pracy makro, ponieważ kopiowanie w komórki z formatowaniem (kolor, czcionki) zajmuje znacznie więcej czasu niż w komórki niesformatowany....
Tu jest szukanie ostatniego, niepustego ActiveSheet.Paste , to wcześniej powinieneś wybrać (Select) lewą, górną komórkę obszaru, lub cały, o tym samym rozmiarze zakres. Nie mam Twojego pliku docelowego, więc pisze wszystko "na czuja". Musisz analizować otrzymany "materiał do przemyślenia" i sygnalizować co, w której linijce nie działa prawidłowo.
A o tworze zwanym FileCopy(source, destination) Kolega słyszał? Jeżeli nie to proszę postudiować Google lub użyć tak jak napisałem. Ścieżki w całości.
O coś takiego chodzi? [syntax=vb]ost_wiersz = Worksheets("Arkusz2").Range("A" & Rows.Count).End(xlUp).Row Worksheets("Arkusz2").Range("A" & ost_wiersz + 1 & ":H" & ost_wiersz + 1).Value = Worksheets("Arkusz1").Range("A1:H1").Val... Worksheets("Arkusz1").Range("A1:H1").Cle...
Zmienna 'tblArkusze' jest tablicą przecież. Musisz w pętli [syntax=vbscript]For i = LBound(tblArkusze) To UBound(tblArkusze) With Sheets(tblArkusze(i)) .Cells.Clear .AutoFilterMode = False End With Next[/syntax]
Dodano po 3 [syntax=vb]Sub Copy() For Each cell In Sheets(2).Range("A:A") If cell.Text = "" Then Exit For Rows(cell.Row & ":" & cell.Row).Copy Sheets(cell.Value).Cells(Rows.Count, 1).End(xlUp).Offset(1) Next End Sub [/syntax] tak dobrze
A czy jest możliwość stworzenia makra, które po kliknięciu przycisku stworzy automatycznie arkusze dla wszystkich osób (i nada nazwy takie jak w pierwszej kolumnie tabeli tj. nazwisko i imię), a jeśli arkusz dla danych osób już istnieje, to je pominie. Można np tak: 968207
[syntax=vbscript]Sub Zawiera() Sheets("Arkusz1").Select a = InputBox("Podaj tekst do szukania: ", "Wyszukaj") ow = Cells(Rows.Count, "A").End(xlUp).Row y = 1 For x = 1 To ow If InStr(1, Cells(x, 2), a) > 0 Then Range(Cells(x, 1), Cells(x, 2)).Copy Sheets("Arkusz2").Range("A" & y) y = y + 1 End If Next End Sub [/syntax] Poniżej bez rozróżniania wielkości...
To 2020 ACTUAL jest w kolumnie B, nie H - może stąd problem? [syntax=vbscript]w = Application.Match("2020 ACTUAL", Range("H1:H" & ow), 0) - 1[/syntax] Zmień H na B.
[syntax=vbscript]Sub DoBazy() kol = Application.Match([C3], Sheets("Baza").Range("A1:GR1"), 0) If Not IsError(kol) Then For i = 1 To 260 Worksheets("Baza").Cells(i, kol) = Worksheets("DoBazy").Cells(i, 3) Next i MsgBox ("Dane dla daty " & [C3] & " zostały skopiowane") Else MsgBox "Brak danych." End If End Sub [/syntax]
Musiałem dodać fragmenty kodu odpowiedzialne za zróżnicowaną numerację kopiowanych przycisków, a następnie identyfikację przycisku "Clear", który został użyty. Wszystkie przyciski "Copy" działają identycznie - kopiują zawsze pierwszą tablicę na pierwsze wolne miejsce. Możesz tej pierwszej tablicy nie wypełniać, potraktować ją jako szablon, unikniesz...
Zacznij z petli For Each c In Sheets(1).Cells.SpecialCells(xlCellTypeA...
Może to Ci pomoże. Makro, dla podanej "szukana" przeszukuje każdy wiersz. Jeżeli znajdzie szukaną to kopiuje cały wiersz i przenosi do innego arkusza Dodano po 3 jeszcze raz bez zbędnych żeczy :) [syntax=vb]Sub Szukaj() Dim wiersz As Integer, kolumna As Byte, szukana As String, NumerWiersza As Integer Dim lastRow As Integer With ActiveSheet lastRow...
Napisanie takiego makra nie jest czymś szczególnie trudnym, tylko ono będzie się dość długo wykonywać. Moja propozycja zmierzała do przyspieszenia tego. [syntax=vbnet]Sub kopiowanie2() ' ' kopiowanie Makro ' Dim r As Range Dim wkcalc As Worksheet Application.ScreenUpdating = False ' Workbooks.Open Filename:= _ "U:\Nowy folder\Arkusz B.xlsx" Set wkcalc...
Moim skromnym zdaniem ostatni dodany arkusz ma najwyższy indeks (nazwę tylko nie tę widoczną w Excelu pod arkuszem) Ustalić go można prosto korzystając z: [syntax=vbscript]OstArk = ActiveWorkbook.Sheets.Count[/syntax] skopiować na koniec: [syntax=vbscript]Sheets(OstArk).Copy After:=Sheets(OstArk)[/syntax] i ostatni krok ze zmianą nazwy: [syntax=vbscript]...
Zmienit 'For i = 0 To nrep - 1' na 'For i = 1 To nrep - 1'
[syntax=vbscript]Sub Kraje() Application.ScreenUpdating = False Sheets("Kraje1").Select ow = Cells(Rows.Count, "A").End(xlUp).Row Range("A2:A" & ow).Copy Sheets("Dane1").Range("J1") For x = ow To 3 Step -1 Rows(x & ":" & x + 4).Insert Sheets("Dane1").Range("A8:D12").Copy Cells(x, 1).PasteSpecial xlPasteValues Next Sheets("Kraje2").Select ow = Cells(Rows.Count,...
Chyba łatwiej zrobić dwuklik na wierszu, z którego chcesz kopiować. Równocześnie uruchamiasz makro i wskazujesz wiersz. Możesz też się upewnić, czy to właściwy wiersz. Oczywiście można też wstawić tam InputBox, tylko wtedy jak chcesz uruchamiać to makro? Jeśli chodzi o moją propozycję, to komórki docelowe wypisujesz po kolei jako adresy obiektu Range:...
[syntax=vbscript]Sub Kopiuj() Set a = ActiveWorkbook i = Application.FileDialog(msoFileDialogOpen... s = Application.FileDialog(msoFileDialogOpen... Set b = Workbooks.Open(s) a.Sheets(1).Range("K20:M23").Copy b.Sheets(1).Range("K20") b.Close True End Sub [/syntax]
No jak chcesz koniecznie kopować: Sub Kopio_aktyw_wiersza() ' ' Kopiowanie danych z aktywnego wiersza kol. A do D ' aktywny = Selection.Row kolumna = 1 ostatnia = Cells(Rows.Count, kolumna).End(xlUp).Row ' bez selekcji od razu kopiowanie wybranych komórek : Range(Cells(aktywny, 1), Cells(aktywny, 4)).Copy 'kopiowanie danych z aktywnego wiersza zakres...
Problem rozwiązany dziękuję za pomoc cały kod wraz z "dodatkowymi funkcjami " Sub kopiowanie() Dim LastRow As Long Range("G11").FormulaR1... = "=NOW()" Range("G11").Copy Range("G12").PasteSpec... Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False...
Trzeba zmienić sposób adresowania w makro z bezwzględnego na względny . A najlepiej związać z aktywną komórką i wtedy nawet nie trzeba go kopiować - jedno makro będzie obsługiwało wszystkie wiersze. :D
Przerobiłem makro z innego wątku PRL - sprawdź czy działa Umieść makro w plik B"plik B.xlsx" PRL po dodaniu elementów z Twojego nagrywania.
Sprawdź czy o to chodzi.
Przy tablicach nie używa się select. A co chcesz potem robić z tą tablicą? Zawsze możesz odwoływać się do komórek arkusza jak do tablicy: For i = 1 To 5 for j = 1 to 5 MsgBox i & ", " & j & " = " & Worksheets("Arkusz1").... j) next j Next i Ewentualnie możesz zapisać dane do zmiennej typu RANGE, do...
w Arkuszu1 ustawiam automatycznie filtr na wartości równe 0 lub "Blanks" w kolumnie V i chciałbym aby makro automatycznie skopiowało wszystkie wiersze do Arkusz2. Wszystkie wiersze z tabeli czy wszystkie WYFILTROWANE wiersze z tej tabeli??
Makro w oddzielnom skoroszycie [syntax=vb]Sub wypelnienie() Dim rd&, rs&, bd As Worksheet, bsh As Worksheet rs = InputBox("Wprowadz numer wiersza danych", "Wiersz #?", 1) path_A = "d:\AAA\" path_B = "d:\AAB\" Set bsh = Workbooks.Open(path_B & "BAZA").Sheets(1) Set bs = Range(Cells(rs, 1), Cells(rs, 7)) plik = Dir(path_A & "*.xlsx") While...
Zerknij do załącznika. Plik zawiera makro.
[syntax=vbscript]Sub Etykiety() Set a = Sheets("Arkusz1") Set b = Sheets("Arkusz2") For x = 2 To a.Cells(Rows.Count, "A").End(xlUp).Row b.Cells(2, 3) = a.Cells(x, 1) b.Cells(4, 3) = a.Cells(x, 2) b.Cells(6, 3) = a.Cells(x, 3) b.Range("A1:C8").PrintOut Next End Sub[/syntax]
Odwołaj się w pętli do arkusza źródłowego/docelowego przez Worksheets("nazwa_arkusza"), a po kropce do konkretnej komórki: albo w postaci .Range("E" & i) albo w postaci .Cells(i, 5), gdzie i - nr wiersza źródła (ew. jeżeli zrobisz w pętli for each c in ...., to możęsz użyć c.Row). Do tego druga zmienna np. j dla wiersza arkusza-celu, czyli: j = 1 for...
nowe rekordy muszą się wklejać po kolei w te tabele obok (A1:D1, A8:D8 itd.) :?: :?: :?: Czy to ma znaczyć, że nowe rekordy mają być dopisywane do poszczególnych tabelek z tym samym ID ??? Jeśli istnieją jakiekolwiek racjonalne przesłanki, że poszczególne segmenty tabeli nie mogą być dziesięcio-wierszowe :cry: to w kodzie te dane mają kopiować się...
żeby kopiowało tak jak kopiuje ale bez otwierania np. zmiana1 i zmiana2 Makro działa w chwili otwarcia arkusza "podsumowanie". Wszystkie dane które były wprowadzone w zmiana1, zmiana2, zmiana3 makro kopiuje i wykasuje dane z arkuszy zmiana1, zmiana2, zmiana3. Jak w piątek nie otwierac "podsumowanie", dane pozostaną aż do poniedziałku, a raczej do czasu...
A nie wystarczy zastosowanie filtrów w "Zeszyt1.xls"? W załączniku rozwiązanie z funkcjami wyszukiwania i kolumnami pomocniczymi. Przy otwarciu kliknij 'Edytuj łącza' i wskaż właściwy plik.
ma nadzieję że zrozumiale jest napisane Niezupełnie. po zliczeniu wszystkich wartości z kol. H ( arkusz1) Chyba chodziło o Arkusz2, a Arkusz1 jest skoroszytem, w którym ma być podsumowanie (?) Założyłem, że nazwy i stawki VAT będą wprowadzone w arkuszu1. Przetestuj takie makro. [syntax=vbscript]Sub Podsumuj() Dim A1 As Worksheet: Set A1 = Workbooks("Arkusz1").Sheets("dok...
to makro do "zabawy" Dodano po 2 jeszcze dwie wersje.... Pierwsza ile_wierszy, to może być niemal dowolna liczba sprawdzonych wierszy , można wpisać nawet tyle ile wierszy ma cała kolumna (zależy od wersji Excela) Chodzi o to by nie sprawdzać całej kolumny bo to może potrwać.... Skopiowane zostaną tylko niepuste komórki. [syntax=vba] Sub copy_cells()...
Panowie liczę na waszą pomoc. Doliczyłeś się.
Nigdy nie programowałem w VBA, ale znalazłem takie coś, może okaże się pomocne. Jeżeli nie to poszukaj w sieci pod hasłami "vba copy rows" i podobnymi, pojawia się sporo wyników. The example codes will copy to a database sheet with the name Sheet2. Every time you run one of the subs the cells will be placed below the last row with data or after the...
Dlaczego nie załączyłeś pliku? Przecież na obrazku niczego nie można sprawdzić. Podejrzewam, że linie obramowania, które Ci się nie kopiują są przypisane do sąsiednich komórek. Ramka rozdziela komórki, ale nie musi być przypisana do obu, może być przypisana tylko do jednej z nich. Wtedy przy kopiowaniu trzeba zadbać o to by obramowania były przypisane...
Jak masz tak ładnie popisane "stare:xxxxxxx" i "nowe:yyyyyy" we wszystkich wierszach to nawet nie musisz sięgać ani do wyrażeń regularnych, ani do VBA :please: Wystarczy zrobić odpowiednią formułę (na bazie fragment.tekstu) w kolumnach C i D i przeciągnąć ją na dół kolumny :idea: :idea:
Tak. Tyle, że w zależności od poziomu zabezpieczeń może być monit lub przy wysokim poziomie może nie działać makro/makra.
Ręce opadają :) To co Ty właściwie chcesz zrobić? ale jeśli dane są pobierane z internetu Dane z internetu wprowadzaj od razu do "z góry upatrzonego" zakresu. lub np z innej komórki Oprogramuj tą "inną komórkę"... Co to znaczy "z automatu"? Żeby coś się zmieniło w arkuszu, najpierw musi się coś wydarzyć.
Odszukaj ten fragment i dodaj ostatnią linijkę: 'kopiuj wartości wscel.Cells(wstaw, 3) = wsbaza.Range("B" & i) wscel.Cells(wstaw, 4) = wsbaza.Range("C" & i) wscel.Range("B" & wstaw) = szukaneTabl(r, 2)
Gdy jest numer wiersza z dane('PODAJ.POZYCJĘ'), nie trzeba 'wyszukaj.pionowo', wystarczy INDEKS
Jeśli makro, następnie tak
Takie proste makro powinno załatwić sprawę: [syntax=vb]Application.ScreenUpdating = False Set wssuma = Worksheets("Suma") ost_wiersz_sumy = wssuma.Cells(wssuma.Rows.Count, 1).End(xlUp).Row For i = 2 To ost_wiersz_sumy With Worksheets(wssuma.Cells(i, 1).Value) ost_wiersz_arkusza = .Cells(.Rows.Count, 2).End(xlUp).Row .Range("B" & ost_wiersz_arkusza +...
Sprawdź takie makro: Cells(CC, 3).Cut zastąp linijką Cells(CC, 3).Copy . Makro działa od pierwszego wiersza, jeśli pierwszy wiersz Twojej tabeli to nagłówek, początkowe parametry CA oraz CC zmień na numer wiersza, od którego zaczynają się faktyczne dane. Makro działa do momentu napotkania pierwszej pustej komórki w kolumnie C.
Wstawiłem tabelę, włączyłem rejestrator makr, zmieniłem nazwę w 'Narzędzia tabel'. Nagrało się m/in: https://obrazki.elektroda.pl/2689543600_... Odpowiedź: Tak, można
Może tak: [syntax=vbscript]Sub Kopiuj() Dim i&, Ow& Application.ScreenUpdating = False Ow = Cells(Rows.Count, "A").End(xlUp).Row For i = 8 To Ow Step 5 Range("A" & i).Copy Range("A" & i + 3, "A" & i + 4) Next End Sub [/syntax] andie
Ok teraz masz kryteria w tablicach w kodzie VBA w razie jakbyś chciał dodać kryterium, musisz zwiększyć tablicę o 1 i dopisać do tego dodatkowego elementu kryterium z gwiazdkami. Jak zobaczysz kod to chyba będziesz wiedział o co kaman. Dodałem też zabezpieczenie przed kliknięciem dwa razy na makro
Spróbuj z InputBox'em: [syntax=vb]w = 14 ile = Int(InputBox("Ile?", "Wpisz liczbę całkowitą", 3)) If ile < 1 Then Exit Sub Application.ScreenUpdating = False Range("A16:V29").Copy For i = 1 To ile Range("A" & 16 + w).Select ActiveSheet.Paste w = w + w Next Application.CutCopyMode = False Application.ScreenUpdating = True[/syntax]
Witam. W arkuszu mam utworzone makro do odznaczania pola wyboru Sub czyszczenie_komórek() Worksheets("wydatki").CheckBoxes.Value = False End Sub Problem pojawia się gdy chcę zmienić nazwę arkusza (lub wykonać jego kopię - co również powoduje zmianę nazwy). Wówczas makro przestaje działać, bo w kodzie makra jest odwołanie do nazwy arkusza, która przecież...
chciałbym napisać proste makro, które po przypisaniu do kontrolki formularza lub kontrolki activeX wykona takie zadanie Po co bawić się w "przyciski" jak można przez 'doubleclick' Kliknij dwa razy na dana cyfrę.
Można też tak (mniej kodu): [syntax=vbscript]Sub PobierzD3() Katalog = "C:\PlikiExcela\" Plik = Dir(Katalog & "*.xls*") x = Sheets("Arkusz1").Cells(Rows.Count, "A").End(xlUp).Row + 1 While Plik <> "" Sheets("Arkusz1").Cells(x, 1) = "='" & Katalog & "[" & Plik & "]Arkusz1'!$D$3" Plik = Dir x = x + 1 Wend End Sub [/syntax]
Z arkusza1 robię raporty w osobnych arkuszach Efekt taki jak na zrzucie 1041538 automatycznego kopiowania wyfiltrowanych danych z arkusza1 do kilku arkuszy :idea: (z nazwami arkuszy wg filtrowanych danych :D ) można zrealizować przykładowo tak jak w załączonym pliku. 1041541 Makro można uruchomić skrótem klawiaturowym ctrl+r :!: , dla dowolnej (jeśli...
Zobacz, czy o to chodziło. Makro do kopiowania: [syntax=vbscript]Sub Kopiuj() Dim b As Worksheet Dim ow As Long Set b = Sheets(ActiveSheet.Index - 1) ow = b.Cells(Rows.Count, "A").End(xlUp).Row - 1 Dim CopyRng As Range, PasteRng As Range b.Range("A4:B" & ow).Copy ActiveSheet.Range("A4").PasteSpecial Paste:=xlPasteValues b.Range("N4:O" & ow).Copy ActiveSheet.Range("N4").PasteSpecial...
Makro super, dzieli arkusze o dane1... dane5, ale nie przekleja arkusz1....arkusz4. Krzyczy błędem w momencie kopiowania arkusza1.
makro kopiować kopiować wartość makro makro kopiować komórka
światła mijać honda generator alternator skanować toshiba studio
Migająca kontrolka silnika w Aprilia SR50 - 5 razy Termet Minimax: Kod błędu 01 i brak resetu