starting at B10. Note this data range can change from day to day.
This statement is too ambiguous to program. Remember that responders in
the NB cannot see your data, so general descriptions cannot be analyzed or
used to make programming decisions.
However, the code below takes the range described in workbook A, Sheet1 and
moves it to workbook B, Sheet 1 in intervals of 73 rows plus the remainder
of less then 73 rows. B10 was the desiginated starting row and K1 was given
as the second destination point. I assumed the K1 was a typo and should
have been K10.
Sub cpyStuff()
Dim wb1 As Workbook, wb2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim lr1 As Long, lr2 As Long
Set wb1 = ThisWorkbook
Set sh1 = wb1.Sheets("Sheet1")
Set wb2 = Workbooks(2) '<<<Change to actual
Set sh2 = wb2.Sheets("Sheet1")
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
For i = lr - 72 To 1 Step -73
lc2 = sh2.Cells(10, Columns.Count).End(xlToLeft).Column
If lc2 < 3 Then
lc2 = 2
Else
lc2 = lc2 + 3
End If
sh1.Cells(i, 1).Resize(70, 7).Copy sh2.Cells(10, lc2)
If i < 73 Then
sh1.Cells(1, 1).Resize(i - 1, 7).Copy sh2.Cells(10, lc2 + 9)
Exit Sub
End If
Next
End Sub
"johncaleb" <(E-Mail Removed)> wrote in message
news:0D06CF44-FB59-4522-B252-(E-Mail Removed)...
> Hi,
> I tried this macro, but didn't work...Not sure what happened.
> Please let me clarify my need...
>
> I have Sheet1 open in WorkBook1 with data in the range A1:G200
> I need a macro to select & copy the last 73 rows of data,in this case
> A128:G200 and paste it on Sheet1 of WorkbookB starting at B10. Note this
> data
> range can change from day to day.
>
> Then copy the next set of 73 rows from the bottom, in this case A56:G127
> and
> Paste that on cell K1 WorkbookB Sheet1.
>
> and so on until all the data is separated as such.
>
> Please help again. thx
>
> "JLGWhiz" wrote:
>
>> Sub dk()
>> Dim rng As Range
>> Set rng = Workbooks(1).Sheets(1).UsedRange
>> rng.Copy Workbooks(2).Sheets(2).Range("A1")
>> Application.CutCopyMode = False
>> Set wb2rng = Workbooks(2).Sheets(2).UsedRange
>> With wb2rng
>> .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
>> End With
>>
>>
>>
>> End Sub
>>
>>
>>
>>
>> "johncaleb" <(E-Mail Removed)> wrote in message
>> news:BB58AD6A-AD7E-4D47-BB11-(E-Mail Removed)...
>> > hi again,
>> >
>> > I have 2 workbooks open. I need a macro to select and copy all
>> > non-blank
>> > cells from Sheet1 FROM one workbook, then paste these cells into the
>> > 2nd
>> > workbook, sheet2 at Cell A1.
>> >
>> > thanks much!
>> >
>>
>>
>> .
>>
|
Similar Threads
