[算表] VBA轉置貼上另存新檔

[ktll (浪跡天涯的旅人)]

軟體:excel

版本:2016

原檔：
https://imgur.com/JdfTA4n

想改成
https://imgur.com/6QTVThH

想把原檔案轉至後貼到另一個新檔案，並且按照分公司名稱存檔
有嘗試爬文來修正，但一直失敗...
遇到有合併的存儲格無法抓取，也不知道怎麼轉置
想請教各位大大幫忙


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

試跑到這邊都是正常的，但後續就不知道如何處理了

謝謝

--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 111.71.215.170 (臺灣)
※ 文章網址: https://www.ptt.cc/bbs/Office/M.1600617478.A.3D5.html
→ soyoso: 有寫新增活頁簿，新增時作用會在新活頁簿上，所以range如
→ soyoso: 要引用巨集工作表內的儲存格、範圍、列或欄時要以.range
→ soyoso: 內文巨集來看，第二列range.autofilter，篩選第三欄，篩選
→ soyoso: 值.range("c" & lLoop)
→ soyoso: 複製範圍range.copy，於新增工作表wbnew，工作表內range.
→ soyoso: pastespecial transpose為真
→ soyoso: lLoop累加cnt減1，lLoop = lLoop + cnt -1
→ soyoso: 另存workbook.saveas
→ ktll: https://imgur.com/oei0WYB
→ ktll: 不好意思，上圖是您上次教我的部分，但我不知道該從哪改起..
→ ktll: 對VBA還不太熟悉...
→ soyoso: １、巨集內有range.copy(這方面保留)，但不要destination
→ soyoso: 以range.pastespecial transpose為真來轉置
→ soyoso: ２、1:1方面標題有二列就改為1:2
→ soyoso: ３、回文寫到lLoop累加cnt減1方面，巨集內也有寫到(這方面
→ soyoso: 也保留)
→ soyoso: ４、巨集也有寫到range.autofit和save方面(這方面也無不用
→ soyoso: 動)
→ soyoso: 就改或新增1,2所提的
→ ktll: https://imgur.com/vgcK6g8
→ ktll: 不知道這樣改是否正確？  但執行的時候出現圖片上的錯誤
→ soyoso: range.copy後面的下底線是要和下行語法做連接的，但range.
→ soyoso: copy和range.pastespecial連接並非正確的語法，下底線要刪
→ soyoso: 除
→ soyoso: 9/21 00:51 range如要引用巨集工作表內的儲存格、範圍、列
→ soyoso: 或欄時要以.range，range.pastespecial是要貼到新增的活頁
→ soyoso: 簿內，所以是以新增活頁簿變數vbnew.工作表.range.
→ soyoso: pastespecial
→ soyoso: range也沒有指定儲存格字串位址，range(..)括號內以儲存格
→ soyoso: 字串位址
→ soyoso: 參數名稱是transpose，巨集內少e
→ ktll: 感謝教學~已經先用別的方式進行了 後續會再來研究