Sub GetData()
Dim sFile As Workbook, tFile As Workbook
Dim dosya As String, kes, parcaAl
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Set tFile = ThisWorkbook
Set s1 = tFile.Sheets("Senelik Mazeret")
Set s2 = tFile.Sheets("Dr.Raporlu Sevk")
Set s3 = tFile.Sheets("Ücretsiz")
Application.ScreenUpdating = False
dosya = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.*")
With s1
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
End With
With s2
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
End With
With s3
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
End With
Do While dosya <> ""
If dosya <> ThisWorkbook.Name Then
Set sFile = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & dosya)
kes = Split(dosya, ".")
parcaAl = Mid(dosya, 1, Len(dosya) - Len(kes(UBound(kes))) - 1)
If parcaAl = "Liste1(Senelik Mazeret)" Then
sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Offset(1).Copy _
s1.Cells(Rows.Count, 1).End(3).Offset(1, 0)
Application.CutCopyMode = False
ElseIf parcaAl = "Liste2(Dr.Raporlu Sevk)" Then
sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Offset(1).Copy _
s2.Cells(Rows.Count, 1).End(3).Offset(1, 0)
Application.CutCopyMode = False
ElseIf parcaAl = "Liste3(Ücretsiz)" Then
sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Offset(1).Copy _
s3.Cells(Rows.Count, 1).End(3).Offset(1, 0)
Application.CutCopyMode = False
End If
Application.CutCopyMode = False
sFile.Close
End If
dosya = Dir
Loop
Application.ScreenUpdating = True
s1.Activate
s1.Cells(1, 1).Activate
MsgBox "Bitti"
Set sFile = Nothing: Set tFile = Nothing: parcaAl = vbNullString
Set s1 = Nothing: Set s2 = Nothing: Set s3 = Nothing
End Sub
Sadece deger ve formatlar kopyalansın derseniz koddaki ilgili yerleri alttaki gibi değiştirin.
If parcaAl = "Liste1(Senelik Mazeret)" Then
sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Offset(1).Copy
s1.Cells(Rows.Count, 1).End(3).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
ElseIf parcaAl = "Liste2(Dr.Raporlu Sevk)" Then
sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Offset(1).Copy
s2.Cells(Rows.Count, 1).End(3).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
ElseIf parcaAl = "Liste3(Ücretsiz)" Then
sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Offset(1).Copy
s3.Cells(Rows.Count, 1).End(3).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If