Question

我将具有多个工作表的工作簿中的数据解析为单个工作簿/工作表。我选择了＆＃34;标题＆＃34;工作表并根据需要将它们安排到我的目标工作簿（活动）中。现在我想从相同的源工作簿（TimeSheet1）和＃34;周日到周六和＃34;（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

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

1 个答案: