Birden fazla dosyayı tek dosyada toplamak

[netkit]

Sayuın omerceri
Workbooks(AlanDosyaAdı).Sheets(1).Columns("A").Copy
satırını
Workbooks(VerenDosyaAdı).Sheets(1).Columns("A").Copy
olarak değiştirince sorun düzeldi fakat dosya isimlerinde 3 den sonra 12 geldiğinden kopyalama sırasını bozuyor. 3,6,9,12 diye sıralama yapmamız gerekıyor.

MT_GUBRF 2011 3 aylik .xls
MT_GUBRF 2011 12 aylik .xls
MT_GUBRF 2011 6 aylik .xls
MT_GUBRF 2011 9 aylik .xls
MT_GUBRF 2012 3 aylik .xls

 

[omerceri]

Makroyu aşağıdaki gibi değiştirirseniz sıralama sorunu çözülür.
Sub dosya()

Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(ThisWorkbook.Path)
Set fc = f.Files
sıra = 1
For Each f1 In fc
If f1.Name <> ThisWorkbook.Name Then

Range("A" & sıra).Value = f1.Name
Range("B" & sıra).Value = Mid(Range("a" & sıra), 4, InStr(1, Range("a" & sıra), "20") - 4)
say = Len(Range("A" & sıra))
For e = 1 To say
If IsNumeric(Mid(Range("A" & sıra), e, 1)) Then
Sayi = Sayi & Mid(Range("A" & sıra), e, 1) * 1
End If


Next
Range("C" & sıra).Value = Sayi
Sayi = ""
sıra = sıra + 1
End If

Next
Columns("A:E").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("C1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
satır = Range("a1").CurrentRegion.Rows.Count
For i = 1 To satır
Range("D" & i).Value = Abs(Application.CountIf(Range("B" & i & ":B" & satır), Range("B" & i)) - Application.CountIf(Range("B1:B" & satır), Range("B1"))) + 1
Next
For e = 1 To satır
If Range("D" & e) = 1 Then
yazi = Range("A" & e)
End If
If Range("D" & e) <> 1 Then

Range("E" & e).Value = yazi
End If
Next
End Sub

 

[netkit]

Sayın omerceri;

ilk kodlarınızı ve son kodları ayrı ayrı dosyalarda çalıştırdım deneme diye klasör açıp 15-20 dosya kopyalıyordum o zaman bir sorun görünmüyordu şimdi full klasörde denedim bazı satırlarda isimlerde kayma gördüm. Acaba bir yerde hatamı yaptım diye tekrardan bakıyorum işlemleri tekrar deniyorum.
Ekte jpeg de 9 ve 10 - 14-15-16 incu satırlar bir örnek uyumsuzluk için.
uyguladıgım klasöreide gönderiyorum eğer vaktiniz var ve bakmak isterim derseniz diye.
ben manuel olarak başladım gene.
ilginize bilginize ve sabrınıza tekrar teşekkür ederim.

 

[omerceri]

Şu an uğraşamıyorum dosya ile ancak klasörde sadece örnek dosya ve "MT_ALCTL 2010 3 aylik .xls" gibi dosyalarınız olsun "FULL" gibi isimler olan dosyalar olmasın. Daha sonra bilgilerin toplandığı ilk dosyaların adını değiştiren ufak bir makro yazarız.

 

[netkit]

Sayin omerceri;
evet full olursa zaten hata mesaji veriyor.
kalan dosyalar zaten 9 tane olmayanlar kaldi yani artik benim makroda calismiyor.
ben bugun itibari ile 5 gun izne ciktim yani dosyayi ptesine kadar test edemeyecegim.
haftaya insallah konu cozume kavusacak.iyi aksalar.