cribal48
New Member
- Joined
- Mar 19, 2020
- Messages
- 1
- Office Version
- 365
- 2019
- 2016
- 2013
- Platform
- Windows
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 to process.
The range currently I set is A2:P20 the next range is 4 rows below and that would be A25:P43.
The sheet that's going to be imported does not have a definite number of rows each time. I was able to loop the range but it returns an empty value causing an error.
The range currently I set is A2:P20 the next range is 4 rows below and that would be A25:P43.
The sheet that's going to be imported does not have a definite number of rows each time. I was able to loop the range but it returns an empty value causing an error.
VBA Code:
[/FONT]
Option Explicit
Public Sub CopySheetToClosedWorkbook()
Dim fileName
Dim closedBook As Workbook
Dim currentSheet As Worksheet
Dim lLastRow As Long
Dim lRow As Long
Dim lRangeSize As Long
Dim lSpacerSize As Long
Dim theRange
fileName = Application.GetOpenFilename("Excel Files (*.xls*),*xls*")
If fileName <> False Then
Application.ScreenUpdating = False
Set closedBook = Workbooks.Open(fileName)
closedBook.Sheets(1).Range("A2:P20").Copy
lRangeSize = 19
lRow = 2
lSpacerSize = 4
lLastRow = 1000
Do Until lRow > lLastRow
Debug.Print Range("A" & lRow).Resize(lRangeSize, 16).Address
theRange = Range("A" & lRow).Resize(lRangeSize, 16).Address
lRow = lRow + lRangeSize + lSpacerSize
closedBook.Sheets(1).Range(theRange).Copy
ThisWorkbook.Worksheets("input").Range("A2").PasteSpecial xlPasteValues
CopySheetAndRenameByCell2
Loop
Application.ScreenUpdating = True
closedBook.Application.CutCopyMode = False
closedBook.Close (True)
End If
End Sub
[FONT=arial]