Add Additional Code

[Rubber Beaked Woodpecker]

Hi all

The following code works very well

Sub logBalance()
   
Dim source As Worksheet
Dim destination As Worksheet
Dim emptyColumn As Long

Set source = Sheets("Sheet8")
Set destination = Sheets("Sheet1")

source.Range("D28:D55").Copy

emptyColumn = destination.Cells(2, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("D2")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(2, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
      destination.Range("X3").Copy
    emptyColumn = destination.Cells(31, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("D2")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(31, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
             
End If
End If
   
End Sub

However I would like to to add this extra piece of code but cannot get this to work.

 source.Range("D28:D55").Select
        Selection.Delete Shift:=xlToLeft

This extra piece of code will be executed after the original code has run.

Thanks
RBW

 

[Rubber Beaked Woodpecker]

I thought that this may be the answer but alas no.

Sub logBalance()
 
Dim source As Worksheet
Dim destination As Worksheet
Dim emptyColumn As Long

Set source = Sheets("Sheet8")
Set destination = Sheets("Sheet1")

source.Range("D28:D55").Copy

emptyColumn = destination.Cells(2, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("D2")) Then
destination.Cells(1, 1).PasteSpecial Transpose:=True
     
Else
emptyColumn = emptyColumn + 1
destination.Cells(2, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
      
destination.Range("X3").Copy
emptyColumn = destination.Cells(31, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("D2")) Then
destination.Cells(1, 1).PasteSpecial Transpose:=True
     
Else
emptyColumn = emptyColumn + 1
destination.Cells(31, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


source.Range("D28:D55").Select
        Selection.Delete Shift:=xlToLeft

           
End If
End If
 
End Sub

 

[Rubber Beaked Woodpecker]

A small tweak and now ok

Sub logBalance()
   
Dim source As Worksheet
Dim destination As Worksheet
Dim emptyColumn As Long

Set source = Sheets("Sheet8")
Set destination = Sheets("Sheet1")

source.Range("D28:D55").Copy

emptyColumn = destination.Cells(2, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("D2")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(2, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
      destination.Range("X3").Copy
    emptyColumn = destination.Cells(31, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("D2")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(31, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    
      
      source.Range("D28:D55").Delete Shift:=xlToLeft
              
End If
End If


   
End Sub