Select a specifc sheets and range in VBA

Question

I parsing data from a workbook with multiple sheets into a single workbook/sheet. I have selected the cells from the "title" sheet and arranged them as needed into my destination workbook(active). Now I would like to select sheets from the same source workbook(TimeSheet1) "Sunday through Saturday"(Sheets3,4,5,6,7,8,9). In each day sheet I would like to specify a cell range of (A2:C57). How can I accomplish this?

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

Are you trying to just select Range(A2:C57) on both sheets, or copy them, or what? — Ampersand
The active workbook/worksheet (thisWorkbook) is the destination. In column G. — Anthropy
So Saturday!A2:C57 to ActiveSheet!G1:I56? And then were did you want to put the range from Sunday? — Ampersand

Ampersand Ampersand · Accepted Answer · 2016-06-02T21:52:19

This loop will copy A2:C57 from sheets 3-9 in WrkBookSrs to G1:I392 in the destination sheet.

For i = 3 To 9

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

Next

If you need to check column 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

Select a specifc sheets and range in VBA

1 Answers