- Katılım
- 5 Eylül 2007
- Mesajlar
- 1,247
- Excel Vers. ve Dili
- ofis 2010
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub SayfalariBirlestir()
Dim i As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "genel"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For i = 2 To Sheets.Count
Sheets(i).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)
Next
Sheets("genel").Select
End Sub
Aşağıdaki gibi deneyebilirsiniz.
Kod:Sub SayfalariBirlestir() Dim i As Integer On Error Resume Next Sheets(1).Select Worksheets.Add Sheets(1).Name = "genel" Sheets(2).Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets(1).Range("A1") For i = 2 To Sheets.Count Sheets(i).Activate Range("A1").Select Selection.CurrentRegion.Select Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp) Next Sheets("genel").Select End Sub