starry1314

回復 9# lpk187


    不好意思..有點卡關 新的程式碼

會選擇所有列,另外用變數計算列後再放入會變只選取最上面兩列
Sub 巨集()
    Dim c As Range, firstAddress$, myColumn%
    With Sheets("工作表1")
        Set c = .Rows(3).Find("P.P", LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                myColumn = 1
                Do
                     .Range(.Cells(2, myColumn), .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area"
                     .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
                    Set c = .Rows(3).FindNext(c)
                    myColumn = myColumn + 19
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
    End With
End Sub

lpk187

回復 11# starry1314


    Option Explicit

Sub 巨集1()
    Dim c As Range, firstAddress$, myColumn%
    With Sheets("工作表1")
        Set c = .Rows(3).Find("P.P", LookIn:=xlValues) '尋求第一個目標物件
            If Not c Is Nothing Then '如果c物件不是為Nothing時，執行
                firstAddress = c.Address '記錄找到的第一個位置
                myColumn = 1 '設定A欄
                Do
                     '.Range(.Cells(2, myColumn), .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area" '
                     .Range(.Cells(Rows.Count, myColumn).End(xlUp), Cells(2, c.Column)).Name = "Print_Area" '設定列印範圍，以設定範圍來說，例如："A1:C5"和"A5:C1"是一樣的意思
                     '只不過A欄可以找到最後一列，所以要用後者來設定範圍
                     .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False '列印
                    Set c = .Rows(3).FindNext(c) '尋找下一個目標物
                    myColumn = myColumn + 19 '下一個個位置為T欄...再來是AM欄，依此類推
                Loop While Not c Is Nothing And c.Address <> firstAddress '當c的位址和第一個位址相同時，跳出迴圈
            End If
    End With
End Sub

starry1314

回復 12# lpk187


    謝謝幫忙~完美運行！