kopiowanie ze skoroszytów do skoroszytu

0

Hej, chciałbym skopiować określone komórki ze wszystkich skoroszytów (poza tym do ktorego sa kopiowane) do jedengo skoroszytu w określone w nim miejsce.

napisałem coś takiego

kopia_nazwa = Range("a1").Value
Worksheets("data").Range("a3").Value = kopia_nazwa

praw1 = Range("e6").Value
Worksheets("data").Range("b" & i).Value = praw1

praw3 = Range("f6").Value
Worksheets("data").Range("c" & i).Value = praw3

praw5 = Range("g6").Value
Worksheets("data").Range("d" & i).Value = praw5

praw10 = Range("h6").Value
Worksheets("data").Range("e" & i).Value = praw10

Znalazłem w internecie kod, który pozwala wykonać dany kod dla wszystkich arkuszów i połączyłem z tym.

ub Dosomething2()
    Dim xSh As Worksheet
    Application.ScreenUpdating = False
    For i = 3 To 168
    For Each xSh In Worksheets
        xSh.Select
        Call RunCode2
    Next
    Next i
    Application.ScreenUpdating = True
End Sub
Sub RunCode2()

Dim kopia_nazwa
Dim praw1
Dim praw3
Dim praw5
Dim praw10
    
kopia_nazwa = Range("a1").Value
Worksheets("data").Range("a3").Value = kopia_nazwa

praw1 = Range("e6").Value
Worksheets("data").Range("b" & i).Value = praw1

praw3 = Range("f6").Value
Worksheets("data").Range("c" & i).Value = praw3

praw5 = Range("g6").Value
Worksheets("data").Range("d" & i).Value = praw5

praw10 = Range("h6").Value
Worksheets("data").Range("e" & i).Value = praw10






End Sub

Co zrobiłem źle? Bądź jak mogę to zrobić w inny sposób?

0

Na zagranicznym forum jeden z użytkowników o nicku: georgiboy dał mi kod to wykonania tego zadania:

Sub test()    
    Dim wsMain As Worksheet, ws As Worksheet, var As Variant
    
    Set wsMain = Sheets("Main")
    For Each ws In ThisWorkbook.Sheets
        With ws
            If .Name <> "Main" Then
                var = Array(.Range("A1"), .Range("E6"), .Range("F6"), .Range("G6"), .Range("H6"))
                wsMain.Range("B" & wsMain.Range("B" & Rows.Count).End(xlUp).Row + 1).Resize(, UBound(var) + 1) = var
            End If
        End With
    Next ws
End Sub

1 użytkowników online, w tym zalogowanych: 0, gości: 1