Arkadaşlar
Aşağıdaki kodda küçük bir değişiklik yaparak,aynı şablondaki 1 den fazla dosyadan B2:AB32 arasındaki dolu satırları Rapor_1 dosyasına aktarabilirmiyiz ?
Yardımlarınız için şimdiden teşekkürler.
Sub Verial()
Dim VeriDosya
Dim i As Byte
ChDrive ("C")
ChDir ("C:/Koop")
Dosya = Dir("*.xls")
While Dosya <> ""
i = i + 1
Workbooks.Open Filename:="C:\Koop\" & Dosya
Workbooks("Koop_Rapor1.xls").ActiveSheet.Cells(i, 2).Value = _
Workbooks(Dosya).ActiveSheet.Range("O33").Value
Workbooks("Koop_Rapor1.xls").ActiveSheet.Cells(i, 3).Value = _
Workbooks(Dosya).ActiveSheet.Range("E33").Value
Workbooks("Koop_Rapor1.xls").ActiveSheet.Cells(i, 4).Value = _
Workbooks(Dosya).ActiveSheet.Range("C33").Value
Workbooks("Koop_Rapor1.xls").ActiveSheet.Cells(i, 1).Value = Dosya
Workbooks(Dosya).Close
Dosya = Dir
Wend
End Sub
Aşağıdaki kodda küçük bir değişiklik yaparak,aynı şablondaki 1 den fazla dosyadan B2:AB32 arasındaki dolu satırları Rapor_1 dosyasına aktarabilirmiyiz ?
Yardımlarınız için şimdiden teşekkürler.
Sub Verial()
Dim VeriDosya
Dim i As Byte
ChDrive ("C")
ChDir ("C:/Koop")
Dosya = Dir("*.xls")
While Dosya <> ""
i = i + 1
Workbooks.Open Filename:="C:\Koop\" & Dosya
Workbooks("Koop_Rapor1.xls").ActiveSheet.Cells(i, 2).Value = _
Workbooks(Dosya).ActiveSheet.Range("O33").Value
Workbooks("Koop_Rapor1.xls").ActiveSheet.Cells(i, 3).Value = _
Workbooks(Dosya).ActiveSheet.Range("E33").Value
Workbooks("Koop_Rapor1.xls").ActiveSheet.Cells(i, 4).Value = _
Workbooks(Dosya).ActiveSheet.Range("C33").Value
Workbooks("Koop_Rapor1.xls").ActiveSheet.Cells(i, 1).Value = Dosya
Workbooks(Dosya).Close
Dosya = Dir
Wend
End Sub