Help with copy macro

K

Kel

I have many tabs that I want to copy information into a new sheet
within the same workbook. I need to Copy A5 into Column A, A10 into
Column B, C3 into Column C. Column D needs to be a total, which is
listed in Column H, but it in different cells, the cell above it always
says Balance. Column E needs to be the last populated cell in the
column that says balance.

I have the following macro, how do I adjust it to get the additional
data?

Sub Copy_Data()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "Copyto"
For Each w In ActiveWorkbook.Worksheets
w.Range("A1").Copy Destination:=Sheets("CopyTo") _
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Thanks!
 
O

Otto Moehrbach

This macro gets some of what you want, but I couldn't figure out what you
wanted with:
"Column D needs to be a total, which is listed in Column H, but it in
different cells, the cell above it always
says Balance. Column E needs to be the last populated cell in the column
that says balance."
Sub Copy_Data()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "Copyto"
For Each w In ActiveWorkbook.Worksheets
Set Dest = [A1]
With Sheets(w)
.[A5].Copy Dest
.[A10].Copy Dest.Offset(, 1)
.[C3].Copy Dest.Offset(, 2)
End With
Set Dest = Dest.Offset(1)
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Post back with more detail about that above part. HTH Otto
 
K

Kel

In my new sheet, I'd like column D to be a cell that's listed in column
H of the old sheets. The cell is never in the same exact location.
The cell above the cell I want always has the word Balance in the cell
above it. The word Balance is only listed in column H on the old
sheets. Is there a way to have the macro do a find for Balance and
then copy the cell that is one below? As for column E for the new
sheet, it needs to be the last populated cell in column H. Maybe
easiest to do a find for Balance then do an end down??

Thanks a million for the help!!
Kelly
 
O

Otto Moehrbach

Kel
Here it is. Lat me know if this works for you. HTH Otto
Sub Copy_Data()
Dim w As Worksheet
Dim CopytoSheet As Worksheet
Dim Dest As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "Copyto"
Set Dest = [A1]
For Each w In ActiveWorkbook.Worksheets
If w.Name = "Copyto" Then GoTo NextSht
With w
.[A5].Copy Dest
.[A10].Copy Dest.Offset(, 1)
.[C3].Copy Dest.Offset(, 2)
.Columns("H:H").Find(What:="Balance",
LookAt:=xlWhole).Offset(1).Copy Dest.Offset(, 3)
.Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)
End With
Set Dest = Dest.Offset(1)
NextSht:
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
K

Kel

Hi, getting a syntax error on this part...how do I fix it?
.Columns("H:H").Find(What:="Balance",
LookAt:=xlWhole).Offset(1).Copy Dest.Offset(, 3)
.Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)
 
D

Dave Peterson

You got hit by a linewrap in the newsgroup post:

Option Explicit

Sub Copy_Data()
Dim w As Worksheet
Dim CopytoSheet As Worksheet
Dim Dest As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "Copyto"
Set Dest = [A1]
For Each w In ActiveWorkbook.Worksheets
If w.Name = "Copyto" Then GoTo NextSht
With w
.[A5].Copy Dest
.[A10].Copy Dest.Offset(, 1)
.[C3].Copy Dest.Offset(, 2)
.Columns("H:H").Find(What:="Balance", _
LookAt:=xlWhole).Offset(1).Copy Dest.Offset(, 3)
.Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)
End With
Set Dest = Dest.Offset(1)
NextSht:
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
K

Kel

Thanks. I fixed it, now I have an object variable or with variable not
set. This is the text that is coming back highlighted.

..Columns("H:H").Find(What:="Balance", LookAt:=xlWhole).Offset(1).Copy
Dest.Offset(, 3)
 
D

Dave Peterson

Now it becomes what should happen if that "balance" isn't found.

This compiled, but I'm not sure it's what you want to do:

Option Explicit
Sub Copy_Data()
Dim w As Worksheet
Dim CopytoSheet As Worksheet
Dim FoundCell As Range
Dim Dest As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "Copyto"
Set Dest = [A1]
For Each w In ActiveWorkbook.Worksheets
If w.Name = "Copyto" Then GoTo NextSht
With w
.[A5].Copy Dest
.[A10].Copy Dest.Offset(, 1)
.[C3].Copy Dest.Offset(, 2)
Set FoundCell = .Columns("H:H").Find(What:="Balance", _
LookAt:=xlWhole)

If FoundCell Is Nothing Then
MsgBox "Not found!"
'what should be done
Else
FoundCell.Offset(1).Copy Dest.Offset(, 3)
End If


.Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)
End With
Set Dest = Dest.Offset(1)
NextSht:
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
K

Kel

Thanks. It works well, one small issue though...the message box is
coming up even though it is populating the new sheet correctly. Why is
the box coming up if it is finding the value?
 
D

Dave Peterson

That message box should only come up with Balance wasn't found:

But this line will execute whether or not it was found:

..Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)
 
K

Kel

The message box is coming up either way, if balance is found or not.
Then, the new sheet is being populated correctly, with the cell below
the balance. All 5 columns are being populated.

Is there a way to just leave the cell blank and continue if balance
isn't found??

Thanks a million!!
 
D

Dave Peterson

If that message is coming up either way, then this code was modified:

Set FoundCell = .Columns("H:H").Find(What:="Balance", _
LookAt:=xlWhole)

If FoundCell Is Nothing Then
MsgBox "Not found!"
'what should be done
Else
FoundCell.Offset(1).Copy Dest.Offset(, 3)
End If

If you changed the code, you may want to post what you're using.
 
K

Kel

Thanks...Now, I have one more issue that I can't figure out. All the
cells in Column H are formulas. I didn't realize that it would make a
difference. How do I change this so that I get the value for the 2
cells that I need in column H? Here's the code that I'm using:

Sub Copy_Data()
Dim w As Worksheet
Dim CopytoSheet As Worksheet
Dim FoundCell As Range


Dim Dest As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "Copyto"
Set Dest = [A1]
For Each w In ActiveWorkbook.Worksheets
If w.Name = "Copyto" Then GoTo NextSht
With w
.[A5].Copy Dest
.[A10].Copy Dest.Offset(, 1)
.[C3].Copy Dest.Offset(, 2)
Set FoundCell = .Columns("H:H").Find(What:="Balance", _
LookAt:=xlWhole)

If FoundCell Is Nothing Then
MsgBox "Not found!"
'what should be done
Else
FoundCell.Offset(1).Copy Dest.Offset(, 3)
End If


.Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)
End With
Set Dest = Dest.Offset(1)
NextSht:
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Also, the message box is still coming up, but pressing enter gets me
right through it. Not sure what that's about, but I'm willing to hit
enter if necessary.

Thanks again,
Kel
 
D

Dave Peterson

I'm not sure what line you're writing about:

If it's this one:
FoundCell.Offset(1).Copy Dest.Offset(, 3)
use:
dest.offset(,3).value = foundcell.offset(1).value

or if it's this line:

..Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)

I'd replace it slightly.

Add a declaration line (near the top)
dim RngToCopy as range

Then that single line
..Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)
becomes this block:

set rngtocopy = .Range("H" & Rows.Count).End(xlUp)
Dest.resize(rngtocopy.rows.count,rngtocopy.columns.count).Offset(, 4).value _
= rngtocopy.value




Thanks...Now, I have one more issue that I can't figure out. All the
cells in Column H are formulas. I didn't realize that it would make a
difference. How do I change this so that I get the value for the 2
cells that I need in column H? Here's the code that I'm using:

Sub Copy_Data()
Dim w As Worksheet
Dim CopytoSheet As Worksheet
Dim FoundCell As Range

Dim Dest As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "Copyto"
Set Dest = [A1]
For Each w In ActiveWorkbook.Worksheets
If w.Name = "Copyto" Then GoTo NextSht
With w
.[A5].Copy Dest
.[A10].Copy Dest.Offset(, 1)
.[C3].Copy Dest.Offset(, 2)
Set FoundCell = .Columns("H:H").Find(What:="Balance", _
LookAt:=xlWhole)

If FoundCell Is Nothing Then
MsgBox "Not found!"
'what should be done
Else
FoundCell.Offset(1).Copy Dest.Offset(, 3)
End If

.Range("H" & Rows.Count).End(xlUp).Copy Dest.Offset(, 4)
End With
Set Dest = Dest.Offset(1)
NextSht:
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Also, the message box is still coming up, but pressing enter gets me
right through it. Not sure what that's about, but I'm willing to hit
enter if necessary.

Thanks again,
Kel
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Rows to Col Macro Question 1
FAO VBA Code MVP's! 4
Macro Help CONT 2003 1
VBA help 2
Copy & paste to protected sheet 3
Copy sheets macro error 3
Coding issue with Excel 2003 1
Macro copy with criteria 8

Top