MS Excel - makro kopiujące dane warunkowane tym czy liczba w komórce jest dodatnia lub ujemna

1
3
495

Cześć.

Jaki należy użyć kodu makra, aby skopiować dane z jednej komórki pliku A z 50 arkuszy do komórki 1, jeżeli liczba jest większa od 0 i do komórki 2, jeżeli liczba jest mniejsza od 0?

Chciałbym kopiować pomiędzy dwoma plikami zawartości komórek z 50 arkuszy jednego pliku albo do komórki A (jeżeli to liczba mniejsza niż 0), albo do komórki B, (jeżeli liczba jest większa niż 0). Dodam, że nazwy arkuszy w obu plikach mają te same nazwy, więc kopiowanie miałoby się odbywać między takimi samymi arkuszami, tylko pomiędzy różnymi plikami. W komórce źródłowej jest jedna komórka, której wartość jest albo liczbą dodatnią, albo ujemną. I tak, jeżeli ujemna, to kopiowanie powinno się odbyć do komórki, dajmy na to A; jeżeli to dodatnia liczba, to kopiowanie powinno się odbyć do komórki dajmy na to B.

Tutaj zamieszczam kod kopiowania, ale nieuwzględniający warunku, czy jest to liczba dodatnia czy ujemna:

Sub CopyRange2()   

Workbooks("Book1.xlsx").Sheets("Sheet1").Range("a1").Copy _        

Workbooks("Book2.xlsx").Sheets("80009").Range("A1")   

Workbooks("Book1.xlsx").Sheets("sheet2").Range("a1").Copy _       

Workbooks("Book2.xlsx").Sheets("80011").Range("A1")   

Workbooks("Book1.xlsx").Sheets("Sheet3").Range("a1").Copy _       

Workbooks("Book2.xlsx").Sheets("80012").Range("A1")   

Workbooks("Book1.xlsx").Sheets("Sheet4").Range("a1").Copy _       

Workbooks("Book2.xlsx").Sheets("80015").Range("A1")   

Workbooks("Book1.xlsx").Sheets("Sheet5").Range("a1").Copy _       

Workbooks("Book2.xlsx").Sheets("80017").Range("A1")

End Sub

Zapytał
@ Tomasz_Czornak | 18.09.2014
- 1
- 1
- 2

8

Witam.

Tutaj podaję rozwiązanie, jakby ktoś potrzebował:

Sub CopyRange2()
Dim i As Integer, j As Integer, arkusz As String, gdzie As Integer
On Error Resume Next
For j = 1 To Workbooks.Count
If ThisWorkbook.Name <> Workbooks(j).Name Then
For i = 1 To ThisWorkbook.Sheets.Count
    arkusz = ThisWorkbook.Sheets(i).Name
    gdzie = (Workbooks(j).Sheets(arkusz).Range("D56").Value > 0) + 54
        If Workbooks(j).Sheets(arkusz).Range("D56").Value < 0 Then
        ThisWorkbook.Sheets(arkusz).Range("D" & gdzie).Value = -Workbooks(j).Sheets(arkusz).Range("D56").Value
        Else
        ThisWorkbook.Sheets(arkusz).Range("D" & gdzie).Value = Workbooks(j).Sheets(arkusz).Range("D56").Value
        End If
Next i
End If
Next j
On Error GoTo 0
End Sub

Pozdrawiam.
Tomek.

Skomentuj

Odpowiedział
@ Tomasz_Czornak | 25.09.2014
- 1
- 1
- 2

Pytanie