Przesunięty przez: Kaper
10-01-2023, 22:45 |
Jak przenieść zawartość wiersza do wskazanego w G1 zeszytu |
| Autor |
Wiadomość |
madasz 
Fan Excela
Wersja: Win Office 2016
Posty: 87
|
 Wysłany: 10-01-2023, 22:23 Jak przenieść zawartość wiersza do wskazanego w G1 zeszytu
|
|
|
Witam Państwa w Nowym Roku i składam Wam wszystkim życzenie wszystkiego najlepszego i oby ten nowy 2023 rok był lepszy od poprzedniego, bez szalonych cen, bez oszalałych prawicowych polityków i zdrowia jeszcze raz zdrowia!
Oto przesyłam fragment makra, z którym nie mogę sobie poradzić.
Makro działa poprawnie z zeszytem ”Rezerwa2”.
Zależy mi na tym by w miejscu , w którym pojawia się tekst :
– ActiveCell.FormulaR1C1 = "Rezerwa2"
i :-„ With Worksheets("Rezerwa2") … - ”Rezerwa2” był pobrany z zawartości komórki G1.
W komórce G1 bywają nazwy innych zeszytów.
Szukałem lecz nie znalazłem rozwiązania (może przeoczyłem!)
Wybaczcie jeśli zawile opisuję problem - brakuje mi wiedzy jestem 77plus.
Pozdrawiam!![/code] |
|
 | ID posta:
424035
|
|
|
 |
|
|
|
|
madasz
Fan Excela
Wersja: Win Office 2016
Posty: 87
|
| Wysłany: 10-01-2023, 22:33
|
|
|
Jak dodać załącznik??
Oto on:
| Kod: | '--------------------------napis rezerwa---------------
Range("G1").Select
'kop do wstaw
Sheets("Dialog").Select
Range("D19").Select
Selection.Copy
Sheets("Lista").Select
Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
ActiveCell.FormulaR1C1 = "Rezerwa2"
Range("A3").Select
'==========================rezerwa=====================
Sheets("lista").Select
Range("b1:f1").Copy
With Worksheets("Rezerwa2")
ActiveWorkbook.Worksheets("Rezerwa2").Range("B1000") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With
'===========================lista========================
Sheets("lista").Select
Range("b1:h1").Copy
|
|
|
 | ID posta:
424038
|
|
|
|
|
|
|
Kaper
Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4407 razy
Posty: 8697
|
| Wysłany: 10-01-2023, 22:43
|
|
|
Nie było dla mnie oczywiste, w którym arkuszu jest ta komórka G1 z nazwą Rezerwa2.
Spróbuj tak jak niżej. Zauważ, że tam gdzie miałeś Rezerwa2 ujęte w cudzysłowy teraz jest mojArkusz bez cudzysłowów.
| Kod: | '--------------------------napis rezerwa---------------
Dim mojArkusz as string
mojArkusz=Sheets("Nazwa_arkusza_z_komórką_G1").Range("G1").value
Range("G1").Select
'kop do wstaw
Sheets("Dialog").Select
Range("D19").Select
Selection.Copy
Sheets("Lista").Select
Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
ActiveCell.FormulaR1C1 = mojArkusz
Range("A3").Select
'==========================rezerwa=====================
Sheets("lista").Select
Range("b1:f1").Copy
With Worksheets(mojArkusz)
ActiveWorkbook.Worksheets("Rezerwa2").Range("B1000") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With
'===========================lista========================
Sheets("lista").Select
Range("b1:h1").Copy |
PS. Ponieważ masz makro, a z nim masz problem, przeniosłem temat do działu "mam problem z makrem" |
_________________
Kaper Jej Królewskiej Mości 
Jeśli dane będą torturowane dość długo, przyznają się do wszystkiego |
|
| ID posta:
424040
|
|
|
|
|
|
madasz
Fan Excela
Wersja: Win Office 2016
Posty: 87
|
| Wysłany: 10-01-2023, 22:54
|
|
|
Dzięki.
To się wszystko odbywa w arkuszu "Lista" i komórka G1 jest w tym arkuszu.
Czyli
| Kod: | | mojArkusz=Sheets("Nazwa_arkusza_z_komórką_G1").Range("G1").value |
zastąpić:
| Kod: | | mojArkusz=Sheets("Lista").Range("G1").value |
??? |
|
| ID posta:
424041
|
|
|
|
|
|
Kaper
Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4407 razy
Posty: 8697
|
| Wysłany: 10-01-2023, 22:55
|
|
|
| Tak |
_________________
Kaper Jej Królewskiej Mości
Jeśli dane będą torturowane dość długo, przyznają się do wszystkiego |
|
| ID posta:
424043
|
|
|
|
|
|
Tajan
Pomógł: 5252 razy
Posty: 11450
|
| Wysłany: 10-01-2023, 23:01
|
|
|
Ten fragment:
| Kod: | With Worksheets(mojArkusz)
ActiveWorkbook.Worksheets("Rezerwa2").Range("B1000") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With |
to chyba raczej powinien tak wyglądać:
| Kod: | With Worksheets(mojArkusz)
ActiveWorkbook.Worksheets(mojArkusz).Range("B1000") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With |
a jeszcze lepiej bez "With/End With":
| Kod: |
ActiveWorkbook.Worksheets(mojArkusz).Range("B1000") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
|
|
|
| ID posta:
424044
|
|
|
|
|
|
Kaper
Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4407 razy
Posty: 8697
|
| Wysłany: 10-01-2023, 23:04
|
|
|
O, dzięki! przegapiłem, czas spać  |
_________________
Kaper Jej Królewskiej Mości
Jeśli dane będą torturowane dość długo, przyznają się do wszystkiego |
|
| ID posta:
424045
|
|
|
|
|
|
madasz
Fan Excela
Wersja: Win Office 2016
Posty: 87
|
| Wysłany: 10-01-2023, 23:17
|
|
|
zatrzymuje się tu:
| Kod: | '==========================rezerwa=====================
Sheets("Lista").Select
Range("b1:f1").Copy
With Worksheets(mojArkusz)
ActiveWorkbook.Worksheets(mojArkusz).Range("B1000") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With |
U Ciebie było
| Kod: | '==========================rezerwa=====================
Sheets("lista").Select
Range("b1:f1").Copy
With Worksheets(mojArkusz)
ActiveWorkbook.Worksheets("Rezerwa2").Range("B1000") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With |
to ("Rezerwa") też zamieniłem na (mojArkusz) i to chyba jest błąd. |
|
| ID posta:
424046
|
|
|
|
|
|
Tajan
Pomógł: 5252 razy
Posty: 11450
|
| Wysłany: 10-01-2023, 23:31
|
|
|
Nie, to nie błąd.
Czy na pewno w aktywnym skoroszycie masz arkusz o nazwie z komórki G1 w arkuszu "Lista"?
Jeżeli tak, to sprawdź dokładnie zawartość tej komórki, czy nie ma np. zbędnych spacji lub literówki. |
|
| ID posta:
424049
|
|
|
|
|
|
madasz
Fan Excela
Wersja: Win Office 2016
Posty: 87
|
| Wysłany: 11-01-2023, 00:51
|
|
|
Wiwat Tajan - miałeś racje tam był brak wartości w G1. Bawię się tym arkuszem od paru lat i stale coś poprawiam, coś przybywa, coś zmieniam i taki klocki wychodzą.
Wiesz mam takiego konika - kolekcjonuję dobre filmy i nawet nie mam czasu ich oglądać. A to G1 miałem już wcześniej poprawić i na zamiarze pozostało. (Ten mój arkusz ma kilkanaście makr - no taki mój bzik...).
Jeszcze raz WIELKIE DZIĘKI !!!!
Na marginesie, jeżeli mogę spytać -dlaczego "a jeszcze lepiej bez "With/End With":"
Pozdrawiam ! |
|
| ID posta:
424053
|
|
|
|
|
|
Tajan
Pomógł: 5252 razy
Posty: 11450
|
| Wysłany: 11-01-2023, 01:14
|
|
|
Gdyż w tym przypadku "With/End With" do niczego nie służy, bowiem nie odwołujesz się do tej instrukcji. Masz podwójne odwołanie do tego samego arkusza, więc jedno z nich jest zbędne. Jeżeli jednak chcesz użyć tej klauzuli to należy to zrobić tak:
| Kod: | With Worksheets(mojArkusz)
.Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With |
jednak, skoro pomiędzy "With" a "End With" nie ma innych instrukcji odwołujących się do tego arkusza, nie ma sensu jej używać. |
|
| ID posta:
424054
|
|
|
|
|
|
madasz
Fan Excela
Wersja: Win Office 2016
Posty: 87
|
| Wysłany: 16-01-2023, 16:13
|
|
|
Witaj.
Próbowałem wysłać Ci na PW opis całego mego problemu.
Ta poprawka, którą sugerowałeś nie pomogła. Oto całość tego makra:
ub | Kod: | Wstaw_Tytuł()
'
' Wstaw_Tytuł Makro
'--------------------------napis rezerwa---------------
Dim mojArkusz As String
mojArkusz = Sheets("Lista").Range("G1").Value
Range("G1").Select
'kop do wstaw
Sheets("Dialog").Select
Range("D19").Select
Selection.Copy
Sheets("Lista").Select
Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
ActiveCell.FormulaR1C1 = mojArkusz
Range("A3").Select
'==========================rezerwa=====================
Sheets("lista").Select
Range("b1:f1").Copy
With Worksheets(mojArkusz)
ActiveWorkbook.Worksheets(mojArkusz).Range("B1000") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With
'===========================lista========================
Sheets("lista").Select
Range("b1:h1").Copy
With Worksheets("lista")
ActiveWorkbook.Worksheets("lista").Range("B6500") _
.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End With
'====================== i sortuj po wstawieniu=====
Range("B7:h6500").Select
ActiveWorkbook.Worksheets("lista").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("lista").Sort.SortFields.Add Key:=Range("B7:B6500"), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("lista").Sort
.SetRange Range("B7:h6500")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'________________________________________kop do select________________________
Range("A1").Select
End Sub |
|
|
| ID posta:
424242
|
|
|
|
|
|
Tajan
Pomógł: 5252 razy
Posty: 11450
|
| Wysłany: 16-01-2023, 18:12
|
|
|
Czytałem twoją wiadomość, ale jej nie zrozumiałem bo nie ma w nim nic o tym na czym polega ten błąd. Z tego co widzę w powyższym kodzie, to za wcześnie przypisujesz do zmiennej nazwę arkusza z komórki G1: | Kod: | | mojArkusz = Sheets("Lista").Range("G1").Value |
bo robisz to zanim do tej komórki zostanie przypisana wartość z komórki D19 arkusza "Dialog".
Ta linia powinna być wstawiona już po nadaniu wartości dla tej komórki
| Kod: | Sub Wstaw_Tytuł()
'
' Wstaw_Tytuł Makro
'--------------------------napis rezerwa---------------
Dim mojArkusz As String
Range("G1").Select
'kop do wstaw
Sheets("Dialog").Select
Range("D19").Select
Selection.Copy
Sheets("Lista").Select
Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
mojArkusz = Sheets("Lista").Range("G1").Value ' <-- powinno być tutaj
ActiveCell.FormulaR1C1 = mojArkusz ' ta linia jest niepotrzebna!
|
|
|
| ID posta:
424244
|
|
|
|
|
|
madasz
Fan Excela
Wersja: Win Office 2016
Posty: 87
|
| Wysłany: 16-01-2023, 19:04
|
|
|
Poprawiłem i teraz jest OK! (Chyba??)
Rozumiem, że nie dajesz nr.tel.
Wprowadziłem wcześniej ściągnięte pliki i działa!
Dzięki Tajan. |
|
| ID posta:
424247
|
|
|
|
|
|
Tajan
Pomógł: 5252 razy
Posty: 11450
|
| Wysłany: 16-01-2023, 19:48
|
|
|
| Kontakt ze mną tylko poprzez forum. |
|
| ID posta:
424249
|
|
|
|
|
|
|
|
Regulamin
