Copy datas from other sheets and put all of them in same sheet

วันนี้ผมนำเสนอการ Copy ข้อมูลที่มีโครงสร้างตารางแบบเดียวกัน ที่อยู่ต่างชีต กัน มารวมไว้ที่เดียวกัน ในที่นี้คือ Sheet 1 ไปจนถึง Sheet 5 มารวมอยู่ในชีต temp เพื่อเตรียมทำการนำ ข้อมูลไปทำการวิเคราะห์ต่อไป รวมถึงทำการ hidden column(สามารถเปลี่ยนเป็นการ delete column ได้) ที่ไม่ต้องการไว้ด้วยในคราวเดียวกัน

I would like to present using macro script to copy datas, that they have same structure but stay in different sheets, and put them together in the same sheet. In this case, I mean copying from sheet 1 to sheet 5 and put all of them in sheet "Temp" to prepare for analysing in the next process. This also includes hiding column (or use deleting column) which we don't want in the same time. 

Sub Macro1()

'

' Macro1 Macro

'

Dim LastRow As Integer, i As Integer, erow As Integer

Dim LastCol As Integer

Sheets("temp").Select

Rows("2:" & Rows.Count).ClearContents

'---------------------------------------

Worksheets("Sheet1").Select

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

i = 1

Range(Cells(1, 1), Cells(LastRow, 21)).Select

Selection.Copy

Worksheets("Temp").Select

ActiveSheet.Cells(1, 1).Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Selection.PasteSpecial Paste:=xlPasteColumnWidths

Selection.PasteSpecial Paste:=xlPasteFormats

i = i + LastRow

'---------------------------------------

Worksheets("Sheet2").Select

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Range(Cells(2, 1), Cells(LastRow, 21)).Select

Selection.Copy

Worksheets("Temp").Select

ActiveSheet.Cells(i, 1).Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Selection.PasteSpecial Paste:=xlPasteFormats

i = i + LastRow - 1

'---------------------------------------

Worksheets("Sheet3").Select

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Range(Cells(2, 1), Cells(LastRow, 21)).Select

Selection.Copy

Worksheets("Temp").Select

ActiveSheet.Cells(i, 1).Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Selection.PasteSpecial Paste:=xlPasteFormats

i = i + LastRow - 1

Worksheets("temp").Select

'---------------------------------------

Worksheets("Sheet4").Select

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Range(Cells(2, 1), Cells(LastRow, 21)).Select

Selection.Copy

Worksheets("Temp").Select

ActiveSheet.Cells(i, 1).Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Selection.PasteSpecial Paste:=xlPasteFormats

i = i + LastRow - 1

Worksheets("temp").Select

'---------------------------------------

Worksheets("Sheet5").Select

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Range(Cells(2, 1), Cells(LastRow, 21)).Select

Selection.Copy

Worksheets("Temp").Select

ActiveSheet.Cells(i, 1).Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Selection.PasteSpecial Paste:=xlPasteFormats

i = i + LastRow - 1

Worksheets("temp").Select

'Range(Cells(1, 1), Cells(i, 21)).AutoFilter Field:=13, Criteria1:="Wait for patch"

'Application.Union(Columns("A"), Columns("C"), Columns("D"), Columns("E"), Columns("G"), Columns("H"), Columns("I"), Columns("L"), Columns("N:R"), Columns("T"), Columns("U")).Select

Worksheets("temp").Columns("A").Hidden = True

Worksheets("temp").Columns("C").Hidden = True

Worksheets("temp").Columns("D").Hidden = True

Worksheets("temp").Columns("E").Hidden = True

Worksheets("temp").Columns("G").Hidden = True

Worksheets("temp").Columns("I").Hidden = True

Worksheets("temp").Columns("L").Hidden = True

Worksheets("temp").Columns("N:R").Hidden = True

Worksheets("temp").Columns("T").Hidden = True

End Sub

Auto Fill Color Rows Based On Cell Value

Public Sub Shade_Timeline()
Dim i, r, start_shade, end_shade, start_year, start_week, end_year, end_week As Integer
Dim star_date, end_date As Variant
i = 5  'This code is start Row=15
For i = i To 10
    If IsEmpty(Cells(i, 2).Value) = False Then
            start_year = DatePart("yyyy", Cells(i, 2))
            start_week = DatePart("ww", Cells(i, 2))
            end_year = DatePart("yyyy", Cells(i, 3))
            end_week = DatePart("ww", Cells(i, 3))            
            Select Case start_year
                Case 1899                   
                   Range(Cells(i, 1), Cells(i, 200)).Select
                   i = i - 1
                   Selection.Delete Shift:=xlUp             
                Case 2011
                    start_shade = 5 + start_week
                    If end_year = 2011 Then end_shade = 5 + end_week
                    If end_year = 2012 Then end_shade = 5 + 52 +                           end_week
                    If end_year = 2013 Then end_shade = 5 + 52 + 52                       + end_week
                    Range(Cells(i, start_shade), Cells(i,                                 end_shade)).Interior.Color = i * 9500
                Case 2012
                    start_shade = 57 + start_week
                    If end_year = 2012 Then end_shade = 57 +                               end_week
                    If end_year = 2013 Then end_shade = 57 + 52 +                         end_week
                    Range(Cells(i, start_shade), Cells(i,                                 end_shade)).Interior.Color = i * 6500
                Case 2013
                    start_shade = 109 + start_week
                    If end_year = 2013 Then end_shade = 109 +                             end_week
                    If end_year = 2014 Then end_shade = 109 + 52 +                         end_week
                    Range(Cells(i, start_shade), Cells(i,                                 end_shade)).Interior.Color = i * 3500
            End Select
    End If
Next
  Range("A1").Select
End Sub

Create Folder and Sub Folder with Excel Macro

Sub CreateFolder()
Dim src As String, fd_name As String, subfd_name As String
Dim rfl As String
src = Range("B1")
i = 2
j = 2
fd_name = Range("B" & i)


Do While Cells(i, 2) <> ""
MkDir src & "\" & fd_name
subfd_name = Range("C" & j)
Do While Cells(j, 3) <> ""
MkDir (src & "\" & fd_name & "\" & subfd_name)
j = j + 1
subfd_name = Range("C" & j)
i = i + 1
On Error GoTo 0
Loop
i = i + 1
j = j + 1
fd_name = Range("B" & i)
On Error GoTo 0
Loop
End Sub

** ตอนนี้ยังไม่สามารถทำงานได้ หากไม่มีช่องว่างระหว่าง Folder //ค้างไว้ก่อน ค่อยหาวิธีแก้

Excel : Replace cells with a Header of column

Code for Replace cells with a Header of column. 

- Design start column and end column that want to replace.
- Copy cell(Header)
- Select range by F5 Go to spacial>Constants>all
  (Select cells that not blank)
- Paste value(Header)
- Loop(Do While)
------------------------------------------------------------------------------------------------------------
Sub ReplaceDataWithHeader()
Dim strCol As String
Dim lngCol As Long
lngCol = 240
 Do While lngCol < 248
    Cells(6, lngCol).Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-18
    Range(Cells(27, lngCol), Cells(8096, lngCol)).Select
    Selection.SpecialCells(xlCellTypeConstants, 23).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    lngCol = lngCol + 1
 Loop
End Sub
------------------------------------------------------------------------------------------------------------