Sub AKTAR_BORÇ()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, S4 As Worksheet
Dim Satır As Long, X As Long
Application.ScreenUpdating = False
Set S1 = Sheets("BORÇ")
Set S2 = Sheets("ALIŞ")
Set S3 = Sheets("FATURA")
Set S4 = Sheets("GİDER")
''''''''''''''''''''''' KALAN BORÇ '''''''''''''''''''''''
S1.Select
Range("B5:T1048576").ClearContents
Satır = 5
''''''''''''''''''''''' ALIŞ '''''''''''''''''''''''
For X = 5 To S2.Range("B1048576").End(3).Row
S1.Range("B" & Satır & "
" & Satır).Value = S2.Range("B" & X & "
" & X).Value
S1.Range("E" & Satır & ":G" & Satır).Value = S2.Range("F" & X & ":H" & X).Value
S1.Range("H" & Satır) = S2.Range("J" & X)
S1.Range("T" & Satır) = S2.Range("K" & X)
Satır = Satır + 1
Next
''''''''''''''''''''''' FATURA '''''''''''''''''''''''
For X = 5 To S3.Range("B1048576").End(3).Row
S1.Range("B" & Satır & "
" & Satır).Value = S3.Range("B" & X & "
" & X).Value
S1.Range("I" & Satır & ":J" & Satır).Value = S3.Range("E" & X & ":F" & X).Value
S1.Range("T" & Satır) = S3.Range("G" & X)
Satır = Satır + 1
Next
''''''''''''''''''''''' GİDER '''''''''''''''''''''''
For X = 5 To S4.Range("B1048576").End(3).Row
S1.Range("B" & Satır & "
" & Satır).Value = S4.Range("B" & X & "
" & X).Value
S1.Range("K" & Satır & ":T" & Satır).Value = S4.Range("E" & X & ":N" & X).Value
Satır = Satır + 1
Next
Set S1 = Nothing
Set S2 = Nothing
Set S3 = Nothing
Set S4 = Nothing
Application.ScreenUpdating = True
MsgBox "Aktarma İşleminiz tamamlanmıştır.", vbInformation
End Sub
İYİ GÜNLER BU KODU BİR KUTUCUĞA TIKLAYINCA ÇALIŞTIRIYORUM
"KALAN ALACAK" DİYE BİR SAYFAM VAR BU SAYFAYI AÇINCA BU KODU ÇALIŞSA BU MÜMKÜNMÜDÜR
YARDIMCI OLABİLİRMİSİNİZ
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, S4 As Worksheet
Dim Satır As Long, X As Long
Application.ScreenUpdating = False
Set S1 = Sheets("BORÇ")
Set S2 = Sheets("ALIŞ")
Set S3 = Sheets("FATURA")
Set S4 = Sheets("GİDER")
''''''''''''''''''''''' KALAN BORÇ '''''''''''''''''''''''
S1.Select
Range("B5:T1048576").ClearContents
Satır = 5
''''''''''''''''''''''' ALIŞ '''''''''''''''''''''''
For X = 5 To S2.Range("B1048576").End(3).Row
S1.Range("B" & Satır & "
S1.Range("E" & Satır & ":G" & Satır).Value = S2.Range("F" & X & ":H" & X).Value
S1.Range("H" & Satır) = S2.Range("J" & X)
S1.Range("T" & Satır) = S2.Range("K" & X)
Satır = Satır + 1
Next
''''''''''''''''''''''' FATURA '''''''''''''''''''''''
For X = 5 To S3.Range("B1048576").End(3).Row
S1.Range("B" & Satır & "
S1.Range("I" & Satır & ":J" & Satır).Value = S3.Range("E" & X & ":F" & X).Value
S1.Range("T" & Satır) = S3.Range("G" & X)
Satır = Satır + 1
Next
''''''''''''''''''''''' GİDER '''''''''''''''''''''''
For X = 5 To S4.Range("B1048576").End(3).Row
S1.Range("B" & Satır & "
S1.Range("K" & Satır & ":T" & Satır).Value = S4.Range("E" & X & ":N" & X).Value
Satır = Satır + 1
Next
Set S1 = Nothing
Set S2 = Nothing
Set S3 = Nothing
Set S4 = Nothing
Application.ScreenUpdating = True
MsgBox "Aktarma İşleminiz tamamlanmıştır.", vbInformation
End Sub
İYİ GÜNLER BU KODU BİR KUTUCUĞA TIKLAYINCA ÇALIŞTIRIYORUM
"KALAN ALACAK" DİYE BİR SAYFAM VAR BU SAYFAYI AÇINCA BU KODU ÇALIŞSA BU MÜMKÜNMÜDÜR
YARDIMCI OLABİLİRMİSİNİZ
