Paste to next row if cells are not empty

[XKruodo]

Hi,

I have a workbook that contains calls details of clients. Those details are
be pasted to individual client workbooks.

I have this macro that pastes call details to workbooks in a folder.

Sub PasteClient()

Dim ClientFile As String 'Holds client's file name
Dim CurRange As Range 'Holds current range selected

'In case of an error this will handle it gracefully and give me
'some information.
On Error GoTo ErrorHandler

'Turn screen updating off. I won't see the client file being updated.
Application.ScreenUpdating = False

' I Make sure proper worksheet is active.
'worksheet is named CALLS.
If ActiveCell.Worksheet.Name <> "CALLS" Then Exit Sub

' This assumes the client
'account number is in column B. Ac No is name of workbook.
If Left(ActiveCell.Address(False, False), 1) <> "B" Then Exit Sub

'I select range in column B. These are cells in column B and
'are contiguous.
Set CurRange = Selection

'Iterate through each cell in selected range of client IDs in
'column B, selecting each client ID then copying client info,
'opening client file, pasting, saving, closing client file.
For Each C In CurRange
'Select the current client id in selected range
C.Select

'Get the client's file name.
ClientFile = ActiveCell.Text & ".xls"

'Select the client data to be posted. This assumes client data
'spans 6 cells
ActiveCell.Range("B1:G1").Copy

'Open the client file for posting. This assumes the path to the
'1000s of client files is in the path "D:\test".
Workbooks.Open Filename:="D:\TEST" & ClientFile

'Assumes the client data will be posted on a worksheet named
'"Sheet1" in the client file just opened.
Sheets("Sheet1").Select

'Position the cursor in the first cell in the client file. Assumes
'client data will be posted beginning in column A5. First 4 rows are
'reserved for clients details.
Range("A5").Select

'Find the first empty cell where the current data can be posted.
'I don't know much about macros but i think i need to change something here
'It finds first empty cell say A17 and pastes across A17 to F17
'even if B17 is NOT empty. it overwrites B17 to F17 if A17 is empty.
'What i want to do is, paste ONLY IF entire row A17 is empty, OR ELSE
' move down to A18 and so on..

Do While ActiveCell.Text > ""
ActiveCell.Offset(1, 0).Select

'Assumes Excel sheets have 65536 rows. This prevents running
'off the bottom of the worksheet and causing an error.

If ActiveCell.Row > 65536 Then Exit Sub
Loop

'Paste the client data into the client worksheet file.
ActiveSheet.Paste

'Cancels the copy mode. Client data can no longer be pasted any where else.
Application.CutCopyMode = False

'Save the client workbook and the posted data just pasted.
ActiveWorkbook.Save

'Close the client workbook.
ActiveWindow.Close

'Get next client data in range selected.
Next C

'Turn screen updating back on.
Application.ScreenUpdating = True

Exit Sub

ErrorHandler:

Select Case Err.Number
Case Is = 1004 'Client file already open or client file does not exist.
'There may be
'other things that will cause this error.
'There are several ways to handle this error. I chose to inform the user
'then exit
'this sub without any alteration to the client file.
MsgBox "There is a problem with client file: " & ClientFile, vbOKOnly +
vbInformation, "An error has occurred ..."
Case Else 'Catches any unexpected errors.
MsgBox "Error number " & Err.Number & " has occurred", vbOKOnly +
vbInformation, "An error has occurred ..."

End Select
End Sub

It would be great if someone can post exactly what to change where...
Thanks a lot.

 

[Rich Locus]

Hello:

If I understand your issue, you are just checking one cell and then pasting,
assuming that all the cells in the same row are empty... which isn't always
the case.

If you want to check the entire row to be empty, just change one statement:

Do While Application.CountA(ActiveCell.EntireRow) <> 0
ActiveCell.Offset(1, 0).Select

'Assumes Excel sheets have 65536 rows. This prevents running
'off the bottom of the worksheet and causing an error.

If ActiveCell.Row > 65536 Then Exit Sub
Loop


Just the top statement in this code was changed. It says keep looping until
you have a count of zero, which means that all the rows are empty.

Hope that helps

 

[XKruodo]

Worked. Thanks a lot.

Hello:

If I understand your issue, you are just checking one cell and then pasting,
assuming that all the cells in the same row are empty... which isn't always
the case.

If you want to check the entire row to be empty, just change one statement:

Do While Application.CountA(ActiveCell.EntireRow) <> 0
ActiveCell.Offset(1, 0).Select

'Assumes Excel sheets have 65536 rows. This prevents running
'off the bottom of the worksheet and causing an error.

If ActiveCell.Row > 65536 Then Exit Sub
Loop


Just the top statement in this code was changed. It says keep looping until
you have a count of zero, which means that all the rows are empty.

Hope that helps