[發問] 請教如何使用vba遍歷各工作表之相同範圍內容COPY至主頁並適時新增Columns數

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2013-1-23 17:28 | 顯示全部帖子

[發問] 請教如何使用vba遍歷各工作表之相同範圍內容COPY至主頁並適時新增Columns數

Dear 版主或各位大大們 :
小弟因為sheet上方會有些圖表,設定為不隨儲存格大小作變動,但又需取得其它sheet之資料(其來源行列數會變動),是否可以每個Sheet之相同位址b2:p12,分別複製資料至Sheet1 b5位址開始,如遇欄位數不足,自動新增來源之columns數,每排僅能有三個範圍資料,第四個則跳第二排,直至結束

Get each sheet data to mainsheet_2013-01-23.zip (27 KB)

樓主熱帖

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

2^#

發表於 2013-1-24 19:52 | 顯示全部帖子

回復 2# stillfish00

您實在太神了,小弟腦筋太死了,其實以版面為主才對,不應該用以新增COLUMNS數,實在太感謝您了,感恩!

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

3^#

發表於 2013-1-24 20:13 | 顯示全部帖子

回復 2# stillfish00

不好意思,小弟還有一個問題忘了提問,那就是假如Sheets name也不都是T開頭,Sheets數也不太一定只有4個,小弟知道要如何count sheets,但也如何避免其它二頁也被copy進來,請問要如何修正為動態,實在再麻煩您予以指導,感恩!

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

4^#

發表於 2013-1-24 22:47 | 顯示全部帖子

回復 5# stillfish00

不好意思,就main & cals 這兩個sheet資料怕會被copy進來,另如果其它sheet name不是01.02.03的序列,不知要如何代入,再煩請您指導,感恩!

Get each sheet data to mainsheet_已回覆.zip (36.29 KB)

帖子: 95
主題: 29
精華: 0
積分: 150
點名: 0
作業系統: windows2003
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: Kaoshiung
註冊時間: 2010-11-5
最後登錄: 2018-2-8

5^#

發表於 2013-1-24 23:49 | 顯示全部帖子

[/code][b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=50094&ptid=8871]6#[/url] [i]cmo140497[/i] [/b]

不好意思,小弟試出來了,用worksheets(index)就OK了,不過仍感謝您的指點迷津,感恩!

[code]Sub Test()
Dim vCols As Long, cIndex As Long, rIndex As Long
Dim first As Long, last As Long
Dim sCopy As String
Dim r, c
Dim myshtc As Long

Worksheets(1).Rows("48:99").Clear

myshtc = ThisWorkbook.Sheets.Count

first = 3
last = myshtc
sCopy = "B6:P16"

r = Range(sCopy).Rows.Count + 1
c = Range(sCopy).Columns.Count + 1

'可見的欄數總數
vCols = Sheets("DashBoard").Cells.SpecialCells(xlCellTypeVisible).Columns.Count

For i = first To last
rIndex = Int((i - first) / Int(vCols / c))
cIndex = (i - first) Mod Int(vCols / c)
newR = r * rIndex
newC = c * cIndex

With Sheets("DashBoard").[R50].Offset(newR, newC)
      .Offset(-1, 1).Value= "ID"
      .Offset(-1, 2).Value = Worksheets(i).Name
      Worksheets(i).Range(sCopy).Copy .Cells(1, 1)
End With
Next i
End Sub