- Katılım
- 24 Kasım 2007
- Mesajlar
- 769
- Excel Vers. ve Dili
- Office 365 - Türkçe
Merhaba
Ekteki dosyada ;
"parçalar" sheetinin A sütununda "X" varsa "XXX" sheetini kopyala ve ismini "parçalar" shettinin B sütünunda yazan ismi ver (rakam:1,2,3...vb)
"parçalar" sheetinin A sütununda "XL" varsa "XXX-Link" sheetini kopyala ve ismini "parçalar" shettinin B sütünunda yazan ismi ver (rakam:1,2,3...vb)
Eğer aynı isimli sheet varsa kopyalama işlemi yapma. Belli noktaya geldim takıldım, XXX veya XXX-Link sayfalarını kopyalamıyor. Makro kaydet ile yaptım, aynı kodları kullandım, yine olmadı.
Dosyam ektedir
Ekteki dosyada ;
"parçalar" sheetinin A sütununda "X" varsa "XXX" sheetini kopyala ve ismini "parçalar" shettinin B sütünunda yazan ismi ver (rakam:1,2,3...vb)
"parçalar" sheetinin A sütununda "XL" varsa "XXX-Link" sheetini kopyala ve ismini "parçalar" shettinin B sütünunda yazan ismi ver (rakam:1,2,3...vb)
Eğer aynı isimli sheet varsa kopyalama işlemi yapma. Belli noktaya geldim takıldım, XXX veya XXX-Link sayfalarını kopyalamıyor. Makro kaydet ile yaptım, aynı kodları kullandım, yine olmadı.
Dosyam ektedir
Kod:
Sub ButtonII()
Dim ad As String, i As Integer, bulundu As Boolean, a As Long
For a = 4 To Range("a65536").End(3).Row
bulundu = False
ad = Sheets("PARCALAR").Cells(a, "b").Value
100 For i = 1 To Worksheets.Count
If CStr(Sheets(i).Name) = CStr(ad) Then
bulundu = True
End If
Next i
If bulundu = False Then
If Sheets("PARCALAR").Cells(a, "a").Value = "X" Then
Sheets("XXX").Copy After:=Sheets(1)
ActiveSheet.Name = CStr(ad)
Else
Sheets("XXX-Link").Copy After:=Sheets(1)
ActiveSheet.Name = CStr(ad)
End If
GoTo 100
End If
Next a
ad = vbNullString
i = Empty: a = Empty
End Sub
Ekli dosyalar
Son düzenleme:
