CODEWITHSUNDEEP
excelvbaloops
cribal48
cribal48

Reputation: 29

Loop a range and skip rows in Excel Worksheet

I have an excel worksheet that accepts input from another excel file. This excel file has structured data in which I need to separate individually as sheets. I already have the following code to copy and format that data in a certain range but I need to loop this process for the whole worksheet until there's no more data.

The range currently I set is A2:P20 the next range is 4 rows below and that would be A25:P43.

    Option Explicit

    Public Sub CopySheetToClosedWorkbook()
    Dim fileName
    Dim closedBook As Workbook
    Dim currentSheet As Worksheet

    fileName = Application.GetOpenFilename("Excel Files (*.xls*),*xls*")

    If fileName <> False Then
        Application.ScreenUpdating = False

        Set currentSheet = Application.ActiveSheet
        Set closedBook = Workbooks.Open(fileName)

        closedBook.Sheets(1).Range("A2:P20").Copy
        ThisWorkbook.Worksheets("input").Range("A2").PasteSpecial xlPasteValues

        closedBook.Application.CutCopyMode = False
        closedBook.Close (True)

        Application.ScreenUpdating = True

        CopySheetAndRenameByCell2

    End If
End Sub

Upvotes: 0

Views: 203

Answers (2)

CLR
CLR

Reputation: 12289

Try this:

Public Sub CopySheetToClosedWorkbook()
    Dim fileName As String
    Dim closedBook As Workbook
    Dim currentSheet As Worksheet

    fileName = Application.GetOpenFilename("Excel Files (*.xls*),*xls*")

    If fileName <> False Then
        start_row = 2
        rows_to_copy = 19
        row_step = 23

        Set currentSheet = Application.ActiveSheet
        Set closedBook = Workbooks.Open(fileName)

        last_row = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row

        Application.ScreenUpdating = False
        For y = start_row To last_row Step row_step
            ThisWorkbook.Worksheets("input").Rows(y).Resize(rows_to_copy, 16).Value = closedBook.Sheets(1).Rows(y).Resize(rows_to_copy, 16).Value
        Next
        Application.ScreenUpdating = True
    End If
End Sub

it's worth mentioning here that you set currentSheet but don't actually use it. Also, you shouldn't really use ThisWorkbook like that. Maybe you should be using currentSheet instead (or at least, it's parent).

Upvotes: 0

Nathan_Sav
Nathan_Sav

Reputation: 8531

You could do something based on the code below. I have set the last row as 1000, you will need to derrive this from your data.

Sub SplitRangeTest()

Dim lLastRow As Long
Dim lRow As Long
Dim lRangeSize As Long
Dim lSpacerSize As Long

lRangeSize = 19
lRow = 2
lSpacerSize = 4
lLastRow = 1000   ' Get the last populated row in the column of choice here

Do Until lRow > lLastRow

    Debug.Print Range("A" & lRow).Resize(lRangeSize, 16).Address

    lRow = lRow + lRangeSize + lSpacerSize

Loop

End Sub

Upvotes: 1

Related Questions