在VBA中select一个特定的表单和范围

我将具有多个工作表的工作簿中的数据parsing到单个工作簿/工作表中。 我已经从“标题”表中select单元格,并根据需要将它们安排到我的目标工作簿(活动)中。 现在我想select来自同一个源工作簿(TimeSheet1)“星期天到星期六”(表格3,4,5,6,7,8,9)的表格。 在每一天工作表中,我想指定一个单元格范围(A2:C57)。 我怎样才能做到这一点?

Sub ParseTimeStudy() Dim WrkBookDest As Workbook Dim WrkBookSrs As Workbook Dim WrkSheetDest As Worksheet Dim WrkSheetSrs As Worksheet ', WrkSheetSrs2 As Worksheet Dim WrkShArray As Worksheets Dim Rng As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range, Rng5 As Range, Rng6 As Range Dim RngWeek As Range Set WrkBookDest = ThisWorkbook Application.ScreenUpdating = 0 Set WrkBookSrs = Workbooks.Open("C:\attach\Timesheet1.xlsx") Set WrkSheetDest = WrkBookDest.Sheets("Sheet1") Set WrkSheetSrs = WrkBookSrs.Sheets("Title") Set WrkShArray = WrkBookSrs.Sheets(Array("Sunday", "Saturday")) 'selecting cells from Title sheet and parsing them to main workbook Set Rng = WrkSheetSrs.Range("A1") 'week Rng.Copy WrkBookDest.Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Set Rng2 = WrkSheetSrs.Range("A2") 'Date range Rng2.Copy WrkBookDest.Sheets("Sheet1").Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Set Rng3 = WrkSheetSrs.Range("B4") 'employee name Rng3.Copy WrkBookDest.Sheets("sheet1").Range("C1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Set Rng4 = WrkSheetSrs.Range("B5") 'Title Rng4.Copy WrkBookDest.Sheets("sheet1").Range("D1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Set Rng5 = WrkSheetSrs.Range("B6") 'Site Rng5.Copy WrkBookDest.Sheets("sheet1").Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Set Rng6 = WrkSheetSrs.Range("B7") 'Loc ID Rng6.Copy WrkBookDest.Sheets("sheet1").Range("F1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Set RngWeek = WrkShArray.Range("A2:C57") RngWeek.Copy WrkBookDest.Sheets("sheet1").Range("FG1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats 'selecting worksheets Sun-Sat 'Set RngWeek = WrkSheetSrs2.Range("A2:C57") 'RngWeek.Copy 'WrkBookDest.Sheets("sheet1").Range("G1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats 'Close workbook sourse: Application.CutCopyMode = False WrkBookSrs.Close ThisWorkbook.Sheets("Sheet1").Columns.AutoFit End Sub 

这个循环会将A2:C57从WrkBookSrs中的工作表3-9复制到目标工作表中的G1:I392。

 For i = 3 To 9 WrkBookSrs.Sheets(i).Range("A2:C57").Copy WrkBookDest.Sheets("sheet1").Range("G" & (i - 3) * 56 + 1) Next 

如果你需要检查C列

 Dim i As Integer, j As Integer, k As Integer k = 1 'row counter for destination sheet 'loop sheets 3-9 For i = 3 To 9 'loop rows 2-57 For j = 2 To 57 'if C is not empty If WrkBookSrs.Sheets(i).Cells(j, 3).Value <> "" Then 'copy A:C on this row to the destination sheet column G row k WrkBookSrs.Sheets(i).Range("A" & j & ":C" & j).Copy WrkSheetDest.Range("G" & k) 'increment counter for next row k = k + 1 End If Next Next