- Katılım
- 8 Haziran 2007
- Mesajlar
- 761
- Excel Vers. ve Dili
- excel- 2003 Türkçe
Makro ile sayfadan sayfaya veri aktarırken iki sutunu toplatıp aktarabilirmiyiz
Sub Aktarma1()
Dim Hucre As Range
Set shD = Sheets("Data")
Set shA = Sheets("Ayrıntı")
y = 7
For Each Hucre In shD.Range("be11:be305")
If Hucre.Value = 0 Or Hucre.Value = "" Then: GoTo f1
shA.Cells(y, 3) = shD.Cells(Hucre.Row, 4)
shA.Cells(y, 4) = shD.Cells(Hucre.Row, 5)
shA.Cells(y, 5) = shD.Cells(Hucre.Row, 47)
shA.Cells(y, 6) = shD.Cells(Hucre.Row, 57)
shA.Cells(y, 7) = shD.Cells(Hucre.Row, 69)
shA.Cells(y, 8) = shD.Cells(Hucre.Row, 68)
shA.Cells(y, 9) = shD.Cells(Hucre.Row, 70)
shA.Cells(y, 10) = shD.Cells(Hucre.Row, 61)
shA.Cells(y, 6) = shD.Cells(Hucre.Row, Hucre.Column)
y = y + 1
f1:
Next
Set shD = Nothing
Set shA = Nothing
End Sub
Sub Aktarma1()
Dim Hucre As Range
Set shD = Sheets("Data")
Set shA = Sheets("Ayrıntı")
y = 7
For Each Hucre In shD.Range("be11:be305")
If Hucre.Value = 0 Or Hucre.Value = "" Then: GoTo f1
shA.Cells(y, 3) = shD.Cells(Hucre.Row, 4)
shA.Cells(y, 4) = shD.Cells(Hucre.Row, 5)
shA.Cells(y, 5) = shD.Cells(Hucre.Row, 47)
shA.Cells(y, 6) = shD.Cells(Hucre.Row, 57)
shA.Cells(y, 7) = shD.Cells(Hucre.Row, 69)
shA.Cells(y, 8) = shD.Cells(Hucre.Row, 68)
shA.Cells(y, 9) = shD.Cells(Hucre.Row, 70)
shA.Cells(y, 10) = shD.Cells(Hucre.Row, 61)
shA.Cells(y, 6) = shD.Cells(Hucre.Row, Hucre.Column)
y = y + 1
f1:
Next
Set shD = Nothing
Set shA = Nothing
End Sub