24/10/2020, 18:12
hegu
Ekte örneğini koyduğum çalışmada hangi aya veri girilirse aynı zamanda otomatik depoda toplanmasını istiyorum. Ben dört sütun veri yazdım bu fazla sütun da olabilir. Yardımlarınız için teşekkür ederim.
(24/10/2020, 18:12)hegu yazdı: Ekte örneğini koyduğum çalışmada hangi aya veri girilirse aynı zamanda otomatik depoda toplanmasını istiyorum. Ben dört sütun veri yazdım bu fazla sütun da olabilir. Yardımlarınız için teşekkür ederim.
(24/10/2020, 18:12)hegu yazdı: hangi aya veri girilirse aynı zamanda otomatik depoda toplanmasını istiyorumMerhaba.
Sub SayfaAktar()
Dim syf As Worksheet
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Depo")
.Range("A2:L" & Rows.Count).ClearContents
For Each syf In ThisWorkbook.Sheets
If LCase(syf.Name) <> "depo" Then
If WorksheetFunction.CountA(syf.Range("A2
syf.Range(syf.Range("A2"), syf.Range("A1").End(xlDown).End(xlToRight)).Copy
.Range("A" & Rows.Count).End(3)(2, 1).PasteSpecial xlValues
End If
End If
Next
End With
MsgBox "islem tamam...", vbInformation, "Bilgi"
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
syf.Range(syf.Range("A2"), syf.Range("A1").End(xlDown).End(xlToRight)).Copy
Eğer satırlar arasında boş olacaksa örneğin Tc sütunucaki satırda boş veri olursa alttaki gibi değiştirilir yukarıdaki kodun.syf.Range("A2
Sub SayfaAktar()
Dim syf As Worksheet
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Depo")
.Range("A2
For Each syf In ThisWorkbook.Sheets
If LCase(syf.Name) <> "depo" Then
If WorksheetFunction.CountA(syf.Range("A2
syf.Range("A2
.Range("A" & Rows.Count).End(3)(2, 1).PasteSpecial xlPasteValuesAndNumberFormats
End If
End If
Next
End With
MsgBox "islem tamam...", vbInformation, "Bilgi"
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub