返回列表 上一主題 發帖

如何設定複製迴圈sheet1複製儲存格至sheet2固定位置????

回復 9# poke0817

1.每次遇到問題內容演變到最後上傳的附件都不一樣,修修改改,很頭痛!
  只能做到這個附檔為止,若有差異請自行修改!
2.請務必下載範例檔詳細看(已設定標籤的列印樣式,幾乎是客製化了∼∼),
  以新入會員無法下載附檔,再破例多提供另一下載址,請儘量參與論壇交流,以提升下載權限!
3.標籤樣式有兩種,所以程式碼分別設置,比對兩種應可更了解程式的意思!
  1. Sub 轉入1()
  2. Dim xA As Range, xB As Range, xR As Range, xH As Range, xE As Range
  3. Call 清除1
  4. Set xA = [清單!C2]: Set xB = [清單!B7]
  5. If xB = "" Then Exit Sub
  6.  
  7. Set xH = [A10]: Set xE = xH '定位資料輸出儲存格位置
  8. Application.ScreenUpdating = False
  9.  
  10. Do: If xH = "" Then Rows("1:8").Copy xH(0, 1) '複製空白樣式
  11.   xE(2, 1) = xA(1, 1) '填入〔料號〕
  12.   xE(3, 2) = xA(1, 1) '填入〔料號〕
  13.   xE(4, 2) = xA(2, 1) '填入〔品名〕
  14.   xE(4, 4) = xA(4, 1) '填入〔批號〕
  15.   xE(5, 2) = xB(1, 2) '填入〔高度1〕
  16.   xE(6, 2) = xB(2, 2) '填入〔高度2〕
  17.   xE(5, 4) = xB(3, 2) '填入〔高度3〕
  18.   xE(6, 4) = xB(4, 2) '填入〔高度4〕
  19.   xE(7, 2) = xB(1, 1) '填入〔盒數〕
  20.   xE(7, 4) = xB(1, 3) '填入〔備註〕
  21.   Set xE = xE(1, 6) '定位下一筆填入位置
  22.   If xE = "" Then Set xH = xH(9): Set xE = xH  '若右方已無可填入表格,向下定位
  23.   Set xB = xB(5, 1) '下一筆資料來源位置
  24. Loop Until xB = ""
  25.  
  26. Rows("1:8").Delete
  27. End Sub
  28.  
  29. '===================================
  30. Sub 清除1()
  31. With ActiveSheet
  32.   .UsedRange.Offset(8, 0).EntireRow.Delete  '清除第8列以下資料
  33.   .[A3,B4,B5:B8,D5:D8] = ""
  34.   .[A2:E8].Copy [F2:o8]
  35. End With
  36. End Sub
複製代碼
 
附件下載:
標籤製作v01.rar (32.79 KB)
或
http://www.funp.net/783355

TOP

回復 11# 准提部林

准提部林  版大,不好意思啦!!原先是想說可以對應的話自己在另外設定其它三組標籤樣式,所以才沒一次說清楚,抱歉啦!!

已經有看到大大設定那三個標籤樣式了,真的是太厲害了..........而且還很貼心的全設定好了,連裁切的部分都考慮到,好大心阿{:3_59:}

努力了解程式原理中............非常感謝部林大大!!:handshake

TOP

        靜思自在 : 有智慧才能分辨善惡邪正;有謙虛才能建立美滿人生。
返回列表 上一主題