Sebastian Ranachowski

Sebastian Ranachowski Pomorskie Centrum
Napraw Pojazdów -
Informatyk,
Marketing...

Temat: Makro do kpiowania Jednego wiersza tabeli

Potrzebuję makro, które pobierze skopiuje jeden wiersz tabeli w arkuszu "A" i wklei go do tabeli w arkuszu "C" po czym przejdzie do następnego wiersza w arkuszu "C".

Po kilku kalkulacjach dane w tabeli z arkusza "A" ulegną zmianie i mają się zapisywać w następnym wierszu w arkuszu "C"

Proszę pomoc :D
Oskar Shon

Oskar Shon Dodatki do Office
www.VBATools.pl

Temat: Makro do kpiowania Jednego wiersza tabeli

Jeden, to znaczy który, jakiś konkretny czy losowo wybrany?
Jaka jest struktura arkusza A i C, tabela w A jakoś się nazywa, czy to po prostu dane w arkuszu, a nie "tabela danych". Generalnie opis problemu "z tyłka wzięty".

Panie szanowny informatyku, szkołę pewnie masz na ukończeniu. Przedstaw w takim razie krótki acz kompletnie tłumaczący warunki w jakich chcesz cokolwiek oprogramować. Załącznik byłby przydatny (dane z kosmosu, logika i typy danych jak w oryginale).
Radosław Dumania

Radosław Dumania Senior Master Data
Analyst

Temat: Makro do kpiowania Jednego wiersza tabeli

Buongiorno!

Jedno z mozliwych rozwiazan.
Trzeba oczywiscie dodac zmienne w miejsce parametrow, pętle i dostosowac do swoich potrzeb, ale to juz kazdy informatyk podobno potrafi zrobic.
Jakby co to Oskar chetnie pomoze

Sub kopiowanie_wierszy()

Dim ws1, ws2 As Worksheet
Dim r_ws1, c_ws1, c1_ws1, r_ws2, c_ws2, c1_ws2 As Integer

Set ws1 = Sheets("A")
Set ws2 = Sheets("B")

r_ws1 = 1
c_ws1 = 1
c1_ws1 = 10

r_ws2 = 1
c_ws2 = 1
c1_ws2 = 10

With ws1
.Range(.Cells(r_ws1, c_ws1), .Cells(r_ws1, c1_ws1)).Copy
End With

With ws2
.Paste Destination:=.Range(.Cells(r_ws2, c_ws2), .Cells(r_ws2, c1_ws2))
End With

End Sub
Sebastian Ranachowski

Sebastian Ranachowski Pomorskie Centrum
Napraw Pojazdów -
Informatyk,
Marketing...

Temat: Makro do kpiowania Jednego wiersza tabeli

Dzieki
Już sobie poradziłem:
Sub Makro14()
'
' Makro14 Makro
'

'

Arkusz6.Cells(Application.WorksheetFunction.CountA(Range("A:A")) + 1, 1).Value = Arkusz1.Cells(20, 2).Value
Arkusz6.Cells(Application.WorksheetFunction.CountA(Range("B:B")) + 1, 2).Value = Arkusz1.Cells(26, 32).Value
Arkusz6.Cells(Application.WorksheetFunction.CountA(Range("C:C")) + 1, 3).Value = Arkusz1.Cells(10, 18).Value
Arkusz6.Cells(Application.WorksheetFunction.CountA(Range("D:D")) + 1, 4).Value = Arkusz1.Cells(30, 24).Value

End Sub



Wyślij zaproszenie do