copy and paste from workbook to workbook

[johncaleb]

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!

 

[JLGWhiz]

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]

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]

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