Code not pasting a cell

Status
Not open for further replies.

gheyman

Well-known Member
Joined
Nov 14, 2005
Messages
2,347
Office Version
  1. 365
Platform
  1. Windows
I have this code which almost works perfectly.

in this section of the code, it is taking the data from the table on DM Cost Source details and pasting in on Cost Source Details in A3 BUT something is happing after that where cell A3 on Cost source Details is blank. All the other data is transfered from the other tab except A3. I dont know if its transfered and then somehow deleted or its just not copying that one cell. ????? Thanks for the help

Sheets("DM Cost Source Details").ListObjects("Cost_Source_Details_Output").DataBodyRange.Copy Sheets("Cost Source Details").Range("A3")

Code:
Sub Execute()
'Run Report Button

On Error Resume Next

Sheet20.Visible = xlSheetVisible
Sheet21.Visible = xlSheetVisible
Sheet19.Visible = xlSheetVisible


Application.ScreenUpdating = False

UserForm1.Show vbModeless

UserForm1.LabelRetrieve.Width = 0
UserForm1.LabelTransform.Width = 0
UserForm1.LabelGenerate.Width = 0


            UserForm1.LabelProg.Width = 20
            UserForm1.LabelProg.Caption = "3%"
            DoEvents


'Refresh
'Cost Sources


         
    With ThisWorkbook
         Sheets("DM Cost Sources").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
     End With
     
            UserForm1.LabelProg.Width = 25
            UserForm1.LabelProg.Caption = "15%"
            DoEvents

    With Sheets("DM Cost Sources")
         .Range("B7").Value = "Last refreshed on: " & Now
     End With
     
            UserForm1.LabelProg.Width = 24
            UserForm1.LabelProg.Caption = "18%"
            DoEvents
     
     
  
  
'Cost Source Details
    
         
    With ThisWorkbook
         Sheets("DM Cost Source Details").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
     End With
     
            UserForm1.LabelProg.Width = 25
            UserForm1.LabelProg.Caption = "26%"
            UserForm1.LabelRetrieve.Width = 42
            DoEvents
     
     
    With Sheets("DM Cost Source Details")
         .Range("B7").Value = "Last refreshed on: " & Now
     End With
     
            UserForm1.LabelProg.Width = 42
            UserForm1.LabelProg.Caption = "30%"
            DoEvents
     
     
'Associated Costs
    
         
    With ThisWorkbook
         Sheets("DM Associated Costs").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
     End With

            UserForm1.LabelProg.Width = 45
            UserForm1.LabelProg.Caption = "42%"
            DoEvents
     
    With Sheets("DM Associated Costs")
         .Range("B7").Value = "Last refreshed on: " & Now
     End With
     
            UserForm1.LabelProg.Width = 48
            UserForm1.LabelProg.Caption = "48%"
            DoEvents
     
     
'Vendors

    'ModelProPricer_vluVendor
    With ThisWorkbook
         Sheets("DM ModelProPricer Vendors List").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
     End With
     
            UserForm1.LabelProg.Width = 75
            UserForm1.LabelProg.Caption = "52%"
            DoEvents

    
         
    With ThisWorkbook
         Sheets("DM Vendors").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
     End With

    With Sheets("DM Vendors")
         .Range("B7").Value = "Last refreshed on: " & Now
     End With
        
     
     
            UserForm1.LabelProg.Width = 78
            UserForm1.LabelProg.Caption = "56%"
            DoEvents


'Transfer***************
'Cost Sources


        Dim lr4 As Long
    
        'Clear existing data if any
        
            Sheets("Cost Sources").Select
                Range("A3").Select
                Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
                Selection.ClearContents
            Range("A3").Select
    
        lr4 = Sheets("Cost Sources").Cells(Rows.Count, "A").End(xlUp).Row
        If lr4 > 2 Then Sheets("Cost Sources").Range("A3:AG" & lr4).ClearContents

        Sheets("DM Cost Sources").ListObjects("Cost_Source_Output").DataBodyRange.Copy Sheets("Cost Sources").Range("A3")

            UserForm1.LabelProg.Width = 84
            UserForm1.LabelProg.Caption = "61%"
            UserForm1.LabelTransform.Width = 48
            DoEvents
            
        With Sheets("DM Cost Sources")
         .Range("B8").Value = "Last transferred on: " & Now
        End With
        
    
'Cost Source Details


        Dim lr5 As Long
    
        'Clear existing data if any
        
            Sheets("Cost Source Details").Select
         '       Range("A3").Select
         '       Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
         '       Selection.ClearContents
         '   Range("A3").Select
            
        lr5 = Sheets("Cost Source Details").Cells(Rows.Count, "A").End(xlUp).Row
        If lr5 > 2 Then Sheets("Cost Source Details").Range("A3:I" & lr5).ClearContents

        Sheets("DM Cost Source Details").ListObjects("Cost_Source_Details_Output").DataBodyRange.Copy Sheets("Cost Source Details").Range("A3")
        
            UserForm1.LabelProg.Width = 95
            UserForm1.LabelProg.Caption = "71%"
            DoEvents
        
        
        With Sheets("DM Cost Source Details")
         .Range("J5").Value = "Last transferred on: " & Now
        End With
        
            UserForm1.LabelProg.Width = 105
            UserForm1.LabelProg.Caption = "75%"
            UserForm1.LabelGenerate.Width = 42
            DoEvents
      
'Associated Costs


        Dim lr6 As Long
    
        'Clear existing data if any
        
            Sheets("Associated Costs").Select
                Range("A3").Select
                Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
                Selection.ClearContents
            Range("A3").Select
            
        lr6 = Sheets("Associated Costs").Cells(Rows.Count, "A").End(xlUp).Row
        If lr6 > 2 Then Sheets("Associated Costs").Range("A3:K" & lr6).ClearContents
        
        
            UserForm1.LabelProg.Width = 128
            UserForm1.LabelProg.Caption = "92%"
            DoEvents

     '   Sheets("DM Associated Costs").ListObjects("Associated_Costs_Output").DataBodyRange.Copy Sheets("Associated Costs").Range("A3")
        
        With Sheets("DM Associated Costs")
         .Range("B8").Value = "Last transferred on: " & Now
        End With
    
 'Vendors


        Dim lr7 As Long
    
        'Clear existing data if any
        
            Sheets("Vendors").Select
                Range("A3").Select
                Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
                Selection.ClearContents
            Range("A3").Select
            
        lr7 = Sheets("Vendors").Cells(Rows.Count, "A").End(xlUp).Row
        If lr7 > 2 Then Sheets("Vendors").Range("A3:U" & lr7).ClearContents
        
        
            UserForm1.LabelProg.Width = 138
            UserForm1.LabelProg.Caption = "98%"
            DoEvents

        Sheets("DM Vendors").ListObjects("Vednor_Output").DataBodyRange.Copy Sheets("Vendors").Range("A3")
        
        With Sheets("DM Vendors")
         .Range("B8").Value = "Last transferred on: " & Now
        End With

  
  UserForm1.Hide
    
Application.ScreenUpdating = True

On Error GoTo 0
End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Why do you have 'On Error Resume Next' at the very top of the code? That will hide errors that could help you solve your problem.

Why do you have 'On Error GoTo 0' at the very bottom of the code? When you exit a sub, 'On Error GoTo 0' is automatically set, no need to manually set it.
 
Upvote 0
Solution
Duplicate to: code not pasting into one cell

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.
 
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,224,829
Messages
6,181,219
Members
453,024
Latest member
Wingit77

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top