Veri Aktarımı

[airborne]

S.A.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheets("Sayfa1").Visible = True
Sheets("Sayfa2").Visible = True
Sheets("Sayfa2").Select
Cells.ClearContents
Sheets("Sayfa1").Select
Columns("A:AK").Select
Selection.Copy
Sheets("Sayfa2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
End Sub

Kodu ile sayfalar arası veri aktarmı yapıyorum. Ancak, Sayfa1 de AE2 ile AE200 arası hücreler boş ise Sayfa1 den Sayfa2 ye Sayfa1!AD'ye kadar, değilse yukarıdaki kod çalışsın. Bir türlü halledemedim.

Selametle.................

 

[Mustafa MUTLU]

Şu Kodu Denermisiniz..

Private Sub CommandButton1_Click()
Sheets("Sayfa2").Range("a2:ak200").ClearContents
MM = 2
MMb = 2

For MSTF1 = 2 To 200
MSTF2 = MSTF2 & Sheets("Sayfa1").Cells(MSTF1, "ae")
Next

If MSTF2 = "" Then

For MSTF = 2 To 200
For MM1 = 1 To 30
Sheets("Sayfa2").Cells(MM, MM1) = Sheets("Sayfa1").Cells(MSTF, MM1)
Next
MM = MM + 1
Next

Else

For MSTFb = 2 To 200
For MM1b = 1 To 37
Sheets("Sayfa2").Cells(MMb, MM1b) = Sheets("Sayfa1").Cells(MSTFb, MM1b)
Next
MMb = MMb + 1
Next

End If
MsgBox "Verileriniz Aktarıldı", vbExclamation, "Mustafa MUTLU 0 533 740 45 49"
End Sub