在 VBA 中选择特定的工作表和范围

Question

我将具有多个工作表的工作簿中的数据解析为单个工作簿/工作表。我从“标题”表中选择了单元格，并根据需要将它们排列到我的目标工作簿（活动）中。现在我想从同一源工作簿（TimeSheet1）“周日到周六”（Sheets3、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

Answer 1

此循环会将 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