Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 64443 Skopiuj do schowka kopiowanie danych , gdzie błąd?
Autor Wiadomość
kamilkamil
Exceloholic


Posty: 202
Wysłany: 15-03-2019, 09:25   kopiowanie danych , gdzie błąd?

kod kopiuje dane z "Arkusz1" do arkusza o nazwie z komórki D3 (czyli w tym przypadku arkusz "x")

W arkuszu "x" do pierwszej kolumny mają się wpisywać dane z komórki S2 "Arkusza1" - tyle razy ile jest danych w "Arkusz1" (czyli w tym przypadku 14 wierszy czyli 14 razy ma się dopisać wartość Y , a dopisuje sie dwa razy więcej). Gdzie jest błąd?

Kod:

Sub kopia()

nazwa = ThisWorkbook.Worksheets("arkusz1").[D3].Value
  Dim tbl: tbl = ThisWorkbook.Worksheets("Arkusz1").[A9:Q40]
  With ThisWorkbook.Worksheets(nazwa)
  .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, "A").Resize(UBound(tbl, 1), 1) = _
            Sheets("Arkusz1").[S2]
    .Cells(.Cells(.Rows.Count, "B").End(xlUp).Row + 1, "B").Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl
  End With
 


gdzie blad.xlsm
Pobierz Plik ściągnięto 10 raz(y) 56.03 KB

ID posta: 364277 Skopiuj do schowka
 
 
Tajan


Pomógł: 4328 razy
Posty: 9614
Wysłany: 15-03-2019, 09:46   

Nie ma błędu. Do tablicy pobierasz stały obszar:
Kod:
tbl = ThisWorkbook.Worksheets("Arkusz1").[A9:Q40]
i wstawiasz tyle wartości ile jest wierszy w tej tablicy, czyli 32.
Należałoby najpierw ustalić ile jest wypełnionych wierszy w obszarze A9:Q40 i tylko te wiersze pobrać do tablicy.
ID posta: 364280 Skopiuj do schowka
 
 
kuma 
Excel Expert


Pomógł: 1198 razy
Posty: 3548
Wysłany: 15-03-2019, 09:47   

Witaj. Trzeba zmienić deklarację tablicy 'tbl' tak, aby "sięgała" tylko niepustych komórek.
Przetestuj
Kod:
Sub kopia()
    Dim tbl
 
    With ThisWorkbook.Worksheets("arkusz1")
        nazwa = .[D3].Value
        tbl = .Range("A9:Q" & .Cells(Rows.Count, "B").End(xlUp).Row)
    End With
    With ThisWorkbook.Worksheets(nazwa)
        .Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 1, "A").Resize(UBound(tbl, 1), 1) = Sheets("Arkusz1").[S2]
        .Cells(.Cells(Rows.Count, "B").End(xlUp).Row + 1, "B").Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl
    End With
End Sub
Pozdrawiam.
ID posta: 364281 Skopiuj do schowka
 
 
kamilkamil
Exceloholic


Posty: 202
Wysłany: 15-03-2019, 10:38   

dzięki , działa
ID posta: 364287 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe