Still trying to use END DOWN

E

Ed Davis

This keeps bombing out on me with a compile error. It happens at the
following place:
Set DestCell = .Range("A34").End(x1Down).Offset(1, 0)

Can someone help me to get this correct.

What I want it to do is the following:
I want to copy the value of a date In Sheet 1 in the cell D4
and the destination will be in the sheet with the name that is located in
Sheet 1 at cell C34.
and the date should go after going to the first empty cell after A34.




Sub Save_Day2()
'
' Save_Day2 Macro
Dim RngToCopy As Range
Dim DestCell As Range

'
'
' Copy Date

Set RngToCopy = Sheets("Sheet1").Range("D4")
On Error Resume Next
With ThisWorkbook.Worksheets
.Item(.Item("Sheet1").Range("C34").Value).Select
End With
If Err.Number <> 0 Then
MsgBox Err.Description
End If

Set DestCell = .Range("A34").End(x1Down).Offset(1, 0)
RngToCopy.Copy
DestCell.PasteSpecial Paste:=x1PasteValues, Operation:=x1None, _
SkipBlanks:=False, Transpose:=False
 
D

Dave Peterson

It's xl (X(ell)), not x1 (x(one))

Ed said:
This keeps bombing out on me with a compile error. It happens at the
following place:
Set DestCell = .Range("A34").End(x1Down).Offset(1, 0)

Can someone help me to get this correct.

What I want it to do is the following:
I want to copy the value of a date In Sheet 1 in the cell D4
and the destination will be in the sheet with the name that is located in
Sheet 1 at cell C34.
and the date should go after going to the first empty cell after A34.

Sub Save_Day2()
'
' Save_Day2 Macro
Dim RngToCopy As Range
Dim DestCell As Range

'
'
' Copy Date

Set RngToCopy = Sheets("Sheet1").Range("D4")
On Error Resume Next
With ThisWorkbook.Worksheets
.Item(.Item("Sheet1").Range("C34").Value).Select
End With
If Err.Number <> 0 Then
MsgBox Err.Description
End If

Set DestCell = .Range("A34").End(x1Down).Offset(1, 0)
RngToCopy.Copy
DestCell.PasteSpecial Paste:=x1PasteValues, Operation:=x1None, _
SkipBlanks:=False, Transpose:=False
Click to expand...
 
E

Ed Davis

I have changed the 1's to "l (ell)" and I still get a compile error at the
same spot.
 
D

Dave Peterson

You dropped the preceding "with" line from the code.

with Sheets("Audilla")
set destcell = .Range("A34").End(xlDown).Offset(1, 0)
end with
 
E

Ed Davis

The reason I dropped the "with Sheets("Audilla") is because I want the code
to pick the sheet with the following code:

On Error Resume Next
With ThisWorkbook.Worksheets
.Item(.Item("Sheet1").Range("C34").Value).Select
End With
If Err.Number <> 0 Then
MsgBox Err.Description
End If

'The sheet's name that I want to goto is in Sheet1 Range D34. and I want the
data to goto to the first empty cell after C34 in the dest. sheet.

'There is a list that is about 20 or so (may change from time to time).
 
E

Ed Davis

Sorry I made a mistake in my last post.
'The sheet's name that I want to goto is in Sheet1 Range C34. and I want the
NOT D34.

The reason I dropped the "with Sheets("Audilla") is because I want the code
to pick the sheet with the following code:

On Error Resume Next
With ThisWorkbook.Worksheets
.Item(.Item("Sheet1").Range("C34").Value).Select
End With
If Err.Number <> 0 Then
MsgBox Err.Description
End If

'The sheet's name that I want to goto is in Sheet1 Range D34. and I want the
data to goto to the first empty cell after C34 in the dest. sheet.

'There is a list that is about 20 or so (may change from time to time).



Ed Davis said:
The reason I dropped the "with Sheets("Audilla") is because I want the
code to pick the sheet with the following code:

On Error Resume Next
With ThisWorkbook.Worksheets
.Item(.Item("Sheet1").Range("C34").Value).Select
End With
If Err.Number <> 0 Then
MsgBox Err.Description
End If

'The sheet's name that I want to goto is in Sheet1 Range D34. and I want
the data to goto to the first empty cell after C34 in the dest. sheet.

'There is a list that is about 20 or so (may change from time to time).
Click to expand...
 
D

Dave Peterson

If the .select is successful, you can use:

With Activesheet

But if that select is unsuccessful, then you be updating the wrong sheet.

I'd use something like:

Dim wks as worksheet 'add this near the other declarations.

set wks = nothing
With ThisWorkbook.Worksheets
on error resume next
set wks = .Item(.Item("Sheet1").Range("C34").Value)
on error goto 0
End With

if wks is nothing then
msgbox "Invalid sheet name in C34 of Sheet1"
exit sub 'quit and don't do any damage????
end if

with wks
set destcell = .Range("A34").End(xlDown).Offset(1, 0)
...

Ed said:
Sorry I made a mistake in my last post.
'The sheet's name that I want to goto is in Sheet1 Range C34. and I want the
NOT D34.

The reason I dropped the "with Sheets("Audilla") is because I want the code
to pick the sheet with the following code:

On Error Resume Next
With ThisWorkbook.Worksheets
.Item(.Item("Sheet1").Range("C34").Value).Select
End With
If Err.Number <> 0 Then
MsgBox Err.Description
End If

'The sheet's name that I want to goto is in Sheet1 Range D34. and I want the
data to goto to the first empty cell after C34 in the dest. sheet.

'There is a list that is about 20 or so (may change from time to time).
Click to expand...
 
E

Ed Davis

OK I have done everything but still when I run this macro more than once I
only get the first section (Copy Date) each time after the first I should
get the others also it would just be duplicated.

This is the new code.

Sub Save_Day2()
'
' Save_Day2 Macro
Dim RngToCopy As Range
Dim DestCell As Range
Dim wks As Worksheet


' Copy Date

Set RngToCopy = Sheets("Sheet1").Range("D4")
On Error Resume Next

Set wks = Nothing
With ThisWorkbook.Worksheets
On Error Resume Next
Set wks = .Item(.Item("Sheet1").Range("c34").Value)
On Error GoTo 0
End With
If wks Is Nothing Then
MsgBox "Invalid sheet name in C34 of sheet1"
Exit Sub
End If

With wks
Set DestCell = .Range("A34").End(xlDown).Offset(1, 0)
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With


'Copy Speed

Set RngToCopy = Sheets("Sheet1").Range("AH34")
On Error Resume Next

Set wks = Nothing
With ThisWorkbook.Worksheets
On Error Resume Next
Set wks = .Item(.Item("Sheet1").Range("C34").Value)
On Error GoTo 0
End With
If wks Is Nothing Then
MsgBox "Invalid sheet name"
Exit Sub
End If

With wks
Set DestCell = .Range("B34").End(xlDown).Offset(1, 0)
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With

'Copy Cash

Set RngToCopy = Sheets("Sheet1").Range("AQ34")
On Error Resume Next

Set wks = Nothing
With ThisWorkbook.Worksheets
On Error Resume Next
Set wks = .Item(.Item("Sheet1").Range("C34").Value)
On Error GoTo 0
End With
If wks Is Nothing Then
MsgBox "Invalid sheet name"
Exit Sub
End If

With wks
Set DestCell = .Range("C34").End(xlDown).Offset(1, 0)
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With


'Copy Voids

Set RngToCopy = Sheets("Sheet1").Range("AZ34")
On Error Resume Next

Set wks = Nothing
With ThisWorkbook.Worksheets
On Error Resume Next
Set wks = .Item(.Item("Sheet1").Range("C34").Value)
On Error GoTo 0
End With
If wks Is Nothing Then
MsgBox "Invalid sheet name"
Exit Sub
End If

With wks
Set DestCell = .Range("D34").End(xlDown).Offset(1, 0)
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With



Dave Peterson said:
If the .select is successful, you can use:

With Activesheet

But if that select is unsuccessful, then you be updating the wrong sheet.

I'd use something like:

Dim wks as worksheet 'add this near the other declarations.

set wks = nothing
With ThisWorkbook.Worksheets
on error resume next
set wks = .Item(.Item("Sheet1").Range("C34").Value)
on error goto 0
End With

if wks is nothing then
msgbox "Invalid sheet name in C34 of Sheet1"
exit sub 'quit and don't do any damage????
end if

with wks
set destcell = .Range("A34").End(xlDown).Offset(1, 0)
...
Click to expand...
 
D

Dave Peterson

Since you're only using one "destination" worksheet, you don't need to check to
see if it exists once.

That doesn't explain why your code isn't working, though.

Are you sure that the cells you're copying from always have data in them. If
they don't, then the cells won't be pasted onto the same row. Could that be the
problem?

Maybe you're pasting in the wrong cells.

If you know that one of those columns always gets a value, you could use that to
determine the row to be used for pasting.

This code worked fine for me if there's always data in columns A:D of the
destination sheet.

Option Explicit
Sub Save_Day2()

Dim RngToCopy As Range
Dim DestCell As Range
Dim wks As Worksheet

Set wks = Nothing
With ThisWorkbook.Worksheets
On Error Resume Next
Set wks = .Item(.Item("Sheet1").Range("c34").Value)
On Error GoTo 0
End With
If wks Is Nothing Then
MsgBox "Invalid sheet name in C34 of sheet1"
Exit Sub
End If

'Copy Date
Set RngToCopy = Sheets("Sheet1").Range("D4")
With wks
Set DestCell = .Range("A34").End(xlDown).Offset(1, 0)
End With
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Copy Speed
Set RngToCopy = Sheets("Sheet1").Range("AH34")
With wks
Set DestCell = .Range("B34").End(xlDown).Offset(1, 0)
End With
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Copy Cash
Set RngToCopy = Sheets("Sheet1").Range("AQ34")
With wks
Set DestCell = .Range("C34").End(xlDown).Offset(1, 0)
End With
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Copy Voids
Set RngToCopy = Sheets("Sheet1").Range("AZ34")
With wks
Set DestCell = .Range("D34").End(xlDown).Offset(1, 0)
End With
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

End Sub

But if you can use column A to pick out the next available row, then you could
use:

This version assumes that you have to have something in D4 (or D34????) and the
row that gets that value is the row the other stuff should be plopped into. And
it assumes that you're using contiguous columns (A:D) on that destination sheet:

Option Explicit
Option Base 0
Sub Save_Day2A()

Dim AddrToCopy As Variant
Dim aCtr As Long
Dim NextRow As Long
Dim wks As Worksheet

'did you really mean D4, not D34???
AddrToCopy = Array("d4", "ah34", "aq34", "az34")

'check to see if the destination sheet exists.
Set wks = Nothing
With ThisWorkbook.Worksheets
On Error Resume Next
Set wks = .Item(.Item("Sheet1").Range("c34").Value)
On Error GoTo 0
End With
If wks Is Nothing Then
MsgBox "Invalid sheet name in C34 of sheet1"
Exit Sub
End If

'check to see if the first cell (d4 or d34) has something in it.
If IsEmpty(Worksheets("Sheet1").Range(AddrToCopy(LBound(AddrToCopy)))) Then
MsgBox "Please put something in: " & AddrToCopy(LBound(AddrToCopy))
Exit Sub
End If

With wks
'starting at the bottom of the column
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
'or starting from Row 34 and working down.
'NextRow = .Cells(34, "A").End(xlDown).Row + 1
End With

For aCtr = LBound(AddrToCopy) To UBound(AddrToCopy)
wks.Cells(NextRow, "A").Offset(0, aCtr).Value _
= Worksheets("Sheet1").Range(AddrToCopy(aCtr)).Value
Next aCtr

End Sub

I like to start at the bottom and look for the next empty cell (.end(xlup)), but
I left the .end(xldown) in the code (but commented).
 

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

Trying to use End Down 2
VBA Coding Help for Beginner 0
Remove Identical words 0
Add to existing macro 3
I'm trying to do a "count" function at the end of a dynamic pivot table 0
Copy data from one sheet to another 0
Prompt for Start Row 2
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0

Top