Arkadaşlar kullanmış olduğum paket programdan aldığım ve her gün değişiklik gösteren xlsx database dosyam var ve burdaki veriler belli bir alana kadar sabit ve belli alandan sonrası hergün değişiklik göstermektedir. Ben her defasında paket programdan toplam veri alarak database dosyasını almak yerine sabit değerin sonuna otomatik olarak değişken değerleri eklettirmek istiyorum.Örneğin elimde database olarak kullandığım örneğin 1.xlsx dosyasının A2:AJ3 verisinin sonuna 2.xlsx dosyasında bulunan A3:AJ4000 aralığındaki verileri otomatik olarak eklettirmek istiyorum. Bunu 2.xlsx dosyasına hazırlamış olduğumuz bir macro ile yapabilmemiz mümkünmüdür? Aynı zamanda 2.xlsx dosyasının database yapısının bozulmamasını istiyorum. Paket programdan toplam sorgulama yaptırmak istediğimde aşırı zaman alıyor ve zaten belli bir tarihe kadarki veriler sabit olduğundan bir değişiklik olmuyor.
Private Sub CommandButton1_Click()
Dim MyRng As Range
Dim NoA1 As Long
Set sh1 = Sheets("Sheet1 (2)")
Set sh2 = Sheets("Sheet1")
NoA1 = sh1.Cells(200000, 1).End(xlUp).Row
For Each MyRng In sh1.Range("A1:A" & NoA1)
NoA2 = sh2.Cells(200000, 1).End(xlUp).Row + 1
If MyRng <> "m.cinsi" And MyRng <> "" Then
sh2.Range("A" & NoA2) = MyRng
sh2.Range("B" & NoA2) = MyRng.Offset(0, 1)
sh2.Range("C" & NoA2) = MyRng.Offset(0, 2)
sh2.Range("D" & NoA2) = MyRng.Offset(0, 3)
sh2.Range("E" & NoA2) = MyRng.Offset(0, 4)
sh2.Range("D" & NoA2) = MyRng.Offset(0, 5)
End If
Next
End Sub
Böyle bir macro kullanarak deneyim dedim çok aşırı yavaş çalışıyor..
Teşekkürler...
Private Sub CommandButton1_Click()
Dim MyRng As Range
Dim NoA1 As Long
Set sh1 = Sheets("Sheet1 (2)")
Set sh2 = Sheets("Sheet1")
NoA1 = sh1.Cells(200000, 1).End(xlUp).Row
For Each MyRng In sh1.Range("A1:A" & NoA1)
NoA2 = sh2.Cells(200000, 1).End(xlUp).Row + 1
If MyRng <> "m.cinsi" And MyRng <> "" Then
sh2.Range("A" & NoA2) = MyRng
sh2.Range("B" & NoA2) = MyRng.Offset(0, 1)
sh2.Range("C" & NoA2) = MyRng.Offset(0, 2)
sh2.Range("D" & NoA2) = MyRng.Offset(0, 3)
sh2.Range("E" & NoA2) = MyRng.Offset(0, 4)
sh2.Range("D" & NoA2) = MyRng.Offset(0, 5)
End If
Next
End Sub
Böyle bir macro kullanarak deneyim dedim çok aşırı yavaş çalışıyor..
Teşekkürler...
Son düzenleme:
