(1)有一總表(如圖:總表) 原本是橫向排列(內容有包含分割儲存格與合併儲存格)
(2)想把表單整理成直向(如圖:篩選後另存新檔(高雄、台中、台北))
(3)將表單依照篩選條件(如高雄、台中、台北)存檔,如圖:資料夾
不知道有沒有巨集可以使用? 有參考一些巨集 但是遇到有合併的儲存格與轉置貼上的時候就出現失敗
謝謝大家
檔案連結
Sub Macro1()
Dim rLastCell As Range
Dim strName As String
Dim lLoop As Long
Dim wbNew As Workbook
Dim cnt As Integer
With ThisWorkbook.Sheets(1)
Set rLastCell = .Cells.Find(What:="*", After:=[A1], _
SearchDirection:=xlPrevious)
For lLoop = 2 To rLastCell.Row
cnt = WorksheetFunction.CountIf(Range("c:c"), Range("c" & lLoop))
Set wbNew = Workbooks.Add
.Range("1:2," & lLoop & ":" & lLoop + cnt - 1).EntireRow.Copy
.vbnew.Sheets(1).Range ("A1")
.Range.PasteSpecial Transpose:=Ture
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Rows.AutoFit
Selection.Columns.AutoFit
wbNew.Close SaveChanges:=True, Filename:=ThisWorkbook.Path _
& Application.PathSeparator & .Cells(lLoop, 3) & ".xlsx"
lLoop = lLoop + cnt - 1
Next lLoop
End With
End Sub




