Hücreleri otomatik kopyalama

[maskex]

Arkadaşlar bir tuş ile tek tıklama ile verilerin kopyalanmasını istiyorum. ekteki dosyamda açıklama yazdım lütfen bir buton ile makro kod tanımlayabilirmisiniz ?

Run tuşuna basınca önce vıp inhouse silinecek ve sonra Vıp Arrivals başlığı altındaki satırların otomatik kopyalanarak VIP ınhouse yapıştırılmasını istiyorum.

Çok acil bir durum şimdiden çok teşekürler.

 

[apocalyt]

şunu bir deneyin...

Sub gümbet()
For x = 1 To 100
If Cells(x, "b") = "VIP ARRIVAL " Then
For y = 1 To 20
If Cells(x, "b") <> "VIP GUEST INHOUSE" Then
a = a + 1: x = x + 1
Else
GoTo atla
End If
Next y
End If
Next x
atla:
For Z = 1 To 20
If Cells(x, "b") <> "VIP DEPARTURE " Then
x = x + 1
b = b + 1
Else
GoTo ben
End If
Next Z
ben:
Range("b" & 17 + a & ":r" & 14 + a + b).ClearContents
If a > b Then
For son = 1 To a - b
Rows(18 + a).Insert
Next son
Range("b17" & ":r" & 14 + a).Copy
Range("b" & 17 + a).PasteSpecial
Else
For son1 = 1 To b - a
Rows(17 + a).Delete
Next son1
Range("b17" & ":r" & 14 + a).Copy
Range("b" & 17 + a).PasteSpecial (xlPasteValuesAndNumberFormats)
End If
Application.CutCopyMode = False
End Sub

 

[maskex]

Ne yazıkki çalışmamaktadır...:S Dosyayı yapabilirmisiniz caba benmi hata yapıyorum :S

 

[apocalyt]

bir dosyayı inceleyin..belkide yanlışta algılamış olabilirim istediğinizi..oda olabilir..

 

[maskex]

bir dosyayı inceleyin..belkide yanlışta algılamış olabilirim istediğinizi..oda olabilir..

Çok teşekürler istediğim bu idi çok sağ olun ...

 

[apocalyt]

rica ederim..

 

[maskex]

Bir isteği daha olacak VIP arrivals sayfasına bir buton koyup o butonada basıldığında wıp arrivalsdaki bilgileri daily info shhet sayfasındaki vıp arrivals kısmına kopyalayabilirmi ?

 

[apocalyt]

benim gönderdiğim dosyadaki kodları aşağıdakilerle değiştirin..sorun çözülcektir..ancak diğer istemiş olduğunuz yani sayfa 3 den sayfa 4 e formüllerle aldığınız bilgilerin kopyalanmasını istemişsiniz..orada çok fazla hücre birleştirdiğinizden ve gizlediğinizden dolayı kopyalamayı yapamadım.eğer sonra çözersem gönderiririm..

Sub gümbet()
For x = 1 To 100
If Cells(x, "b") = "VIP ARRIVAL " Then
For y = 1 To 20
If Cells(x, "b") <> "VIP GUEST INHOUSE" Then
a = a + 1: x = x + 1
Else
GoTo atla
End If
Next y
End If
Next x
atla:
For Z = 1 To 20
If Cells(x, "b") <> "VIP DEPARTURE " Then
x = x + 1
b = b + 1
Else
GoTo ben
End If
Next Z
ben:
a = a - 2
b = b - 2
alem = Range("d" & 19 + a + b).End(3).Row + 1
day1 = 19 + a + b - alem
days = Range("d" & 16 + a).End(3).Row + 1
days2 = days - 17
If days2 >= day1 Then

For son = 1 To days2 - day1
Rows(alem).Insert
Next son
Range("b17" & ":r" & days - 1).Copy
Range("b" & alem).PasteSpecial
Else
For son1 = 1 To day1 - days2
Rows(alem).Delete
Next son1
Range("b17" & ":r" & days - 1).Copy
Range("b" & alem).PasteSpecial (xlPasteValuesAndNumberFormats)
End If
Application.CutCopyMode = False
End Sub

 

[maskex]

benim gönderdiğim dosyadaki kodları aşağıdakilerle değiştirin..sorun çözülcektir..ancak diğer istemiş olduğunuz yani sayfa 3 den sayfa 4 e formüllerle aldığınız bilgilerin kopyalanmasını istemişsiniz..orada çok fazla hücre birleştirdiğinizden ve gizlediğinizden dolayı kopyalamayı yapamadım.eğer sonra çözersem gönderiririm..

Sub gümbet()
For x = 1 To 100
If Cells(x, "b") = "VIP ARRIVAL " Then
For y = 1 To 20
If Cells(x, "b") <> "VIP GUEST INHOUSE" Then
a = a + 1: x = x + 1
Else
GoTo atla
End If
Next y
End If
Next x
atla:
For Z = 1 To 20
If Cells(x, "b") <> "VIP DEPARTURE " Then
x = x + 1
b = b + 1
Else
GoTo ben
End If
Next Z
ben:
a = a - 2
b = b - 2
alem = Range("d" & 19 + a + b).End(3).Row + 1
day1 = 19 + a + b - alem
days = Range("d" & 16 + a).End(3).Row + 1
days2 = days - 17
If days2 >= day1 Then

For son = 1 To days2 - day1
Rows(alem).Insert
Next son
Range("b17" & ":r" & days - 1).Copy
Range("b" & alem).PasteSpecial
Else
For son1 = 1 To day1 - days2
Rows(alem).Delete
Next son1
Range("b17" & ":r" & days - 1).Copy
Range("b" & alem).PasteSpecial (xlPasteValuesAndNumberFormats)
End If
Application.CutCopyMode = False
End Sub

Bu verdiğiniz kodu yapıştırınca olmadı.Ben dosyayı tekrar ekliyorum ve içini tekrar nasıl yapılması gerektiği ile ilgili açıklama yaptım.

1: Daily infosheet sayfası sağdaki run tuşuna basılınca
1a:Yine aynı sayfadaki Vıp arrivals dolu alanları olan b17-b20 aralığı kopyalanarak
2a :Yine aynı sayfadaki Vıp inhouse alanının en son dolu hücresi olan b30 dan sonra yapıştırılacak ( satır eklemek gerekirse kendisi otomatik ekleyecek )

Not: Boş satırları kopyalamsına gerek yok.


2. Fonksiyo :

Girdi sayfasına run tuşu yapılacak tıklayınca;

Girdi sayfasındaki dolu hücreler daily infosheet sayfasındaki VIP Arrivals silinerek yerine girdi sayfasındaki bilgiler kopyalanarak ilgili yerlere otomatik yapıştırılacak.

Umarım açık ve net olmuştur.