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

Posted 2023-04-13

【中文标题】在 VBA 中选择特定的工作表和范围

【英文标题】：Select a specifc sheets and range in VBA

【发布时间】：2016-06-02 20:47:38

【问题描述】：

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

【问题讨论】：

你是想在两张纸上都选择 Range(A2:C57)，还是复制它们，还是什么？

我正在尝试仅将 Rang(A2:C57) 复制到第 3 - 9 页。

啊。你想把它们粘贴到哪里？

活动工作簿/工作表 (thisWorkbook) 是目标。在 G 列中。

那么星期六！A2:C57 到 ActiveSheet！G1:I56？然后你想把范围从星期天开始吗？

【参考方案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

【讨论】：

效果很好！谢谢好先生。在数据源列 C 中排除具有空值的行是否足够容易？

那么你需要添加一个嵌套循环来检查C列中的每个单元格，并且只有在它不为空时才复制。

谢谢你太棒了！