snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Sub CollectData()
Dim ws As Worksheet
Dim r As Range
Dim rTarget As Range
Dim DataAll As String
DataAll = "Sheet2"
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> DataAll Then
With Sheets(DataAll)
Set rTarget = .Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
End With
Set r = ws.Range("D11")
r.Copy
rTarget.PasteSpecial xlPasteValues
End If
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub