CODEWITHSUNDEEP
vbaexcel
jg2703
jg2703

Reputation: 171

Excel VBA Insert Number of Rows for Copied Data using Resize

I want to copy a range of cells from Workbook1.xlsm and Insert them in Workbook2.xltm.

I will need to insert enough rows in Workbook2 to 'cope' with the size of the data, which will vary. Thanks to jspek I've the following macro but this doesn't insert the rows in Workbook2.

From much Googling I came to this . All I can see is that I need to use .Resize.

My Trial Macro

sub rangeCopy()
Dim sourceRange As Range, loopRange As Range
Dim targetRange As Range
Dim lastRow As Long
Dim sourceCounter As Long
Dim targetCounter As Long
Dim outString As String
Dim startRow As Long
Dim startCol As Long
Dim endCol As Long
Dim colCounter As Long

Set sourceRange = Sheets("Input Sheet").Range("A9:C800")
Set targetRange = Workbooks.Open("C:\Users\j\Documents\Workbook2.xltm").Sheets("Quote").Range("A4")
startRow = sourceRange.Row
lastRow = sourceRange.Rows.Count
startCol = sourceRange.Column
endCol = sourceRange.Columns.Count - 1
Set loopRange = sourceRange.Parent.Cells(startRow, startCol)

For colCounter = 0 To endCol
    targetCounter = 0
    For sourceCounter = 0 To lastRow - 1

        outString = Trim(loopRange.Offset(sourceCounter, colCounter).Value)

        While (Trim(targetRange.Offset(targetCounter, colCounter).Value) <> "")
            targetCounter = targetCounter + 1
        Wend

        targetRange.Offset(targetCounter, colCounter).Value = outString
    Next
Next
End Sub

Upvotes: 0

Views: 902

Answers (1)

Stupid_Intern
Stupid_Intern

Reputation: 3450

Just the idea of what I was trying to suggest you need to make changes and debug it to suit it to your needs

sub rangeCopy()
Dim p As long
Set targetRange = Workbooks.Open("C:\Users\j\Documents\Workbook2.xltm").Sheets("Quote").Range("A4")

Dim FRow As Long
Dim m As Long
m =Sheets("Input Sheet").Rows.Count
FRow = Sheets("Input Sheet").Range("A" & m).End(xlUp).Row

Set sourceRange = Sheets("Input Sheet").Range("A9:C" &FRow)
sourceRange.Copy
Sheets("Quote").Rows("4:4").Select Selection.Insert Shift:=xlDown
p= FRow + 5
Sheets("Quote").Rows("4:" & p).Copy
Sheets("Quote").Rows("4:4").PasteSpecial xlPasteValues

Application.CutCopyMode = False

End Sub

Upvotes: 0

Related Questions