code not pasting into one cell

gheyman

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 one section its pasting from the one tab to the other but for some reason cell A3 is blank on the destination tab. On the source there is data. I dont know if that one cell is not being copied or A3 is being deleted after the data is pasted in

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

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
Review the name of each item (sheets, table)

Remove this statement and run the macro.
VBA Code: 
On Error Resume Next

Check if there is an error in the line:
VBA Code: 
Sheets("DM Cost Source Details").ListObjects("Cost_Source_Details_Output").DataBodyRange.Copy Sheets("Cost Source Details").Range("A3")
 
Upvote 0
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
With that being said, see how the following shortened code performs:

VBA Code: 
Sub Execute()
'   Run Report Button
'
    Dim lr4 As Long
    Dim lr5 As Long
    Dim lr6 As Long
    Dim lr7 As Long
'
    Sheet19.Visible = xlSheetVisible
    Sheet20.Visible = xlSheetVisible
    Sheet21.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
'
    ThisWorkbook.Sheets("DM Cost Sources").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
'
      UserForm1.LabelProg.Width = 25
    UserForm1.LabelProg.Caption = "15%"
    DoEvents
'
    Sheets("DM Cost Sources").Range("B7").Value = "Last refreshed on: " & Now
'
      UserForm1.LabelProg.Width = 24
    UserForm1.LabelProg.Caption = "18%"
    DoEvents
'
'Cost Source Details
'
    ThisWorkbook.Sheets("DM Cost Source Details").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
'
        UserForm1.LabelProg.Width = 25
      UserForm1.LabelProg.Caption = "26%"
    UserForm1.LabelRetrieve.Width = 42
    DoEvents
'
    Sheets("DM Cost Source Details").Range("B7").Value = "Last refreshed on: " & Now
'
      UserForm1.LabelProg.Width = 42
    UserForm1.LabelProg.Caption = "30%"
    DoEvents
'
'Associated Costs
'
    ThisWorkbook.Sheets("DM Associated Costs").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
'
      UserForm1.LabelProg.Width = 45
    UserForm1.LabelProg.Caption = "42%"
    DoEvents
'
    Sheets("DM Associated Costs").Range("B7").Value = "Last refreshed on: " & Now
'
      UserForm1.LabelProg.Width = 48
    UserForm1.LabelProg.Caption = "48%"
    DoEvents
'
'Vendors
'
'   ModelProPricer_vluVendor
    ThisWorkbook.Sheets("DM ModelProPricer Vendors List").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
'
      UserForm1.LabelProg.Width = 75
    UserForm1.LabelProg.Caption = "52%"
    DoEvents
'
    ThisWorkbook.Sheets("DM Vendors").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
'
    Sheets("DM Vendors").Range("B7").Value = "Last refreshed on: " & Now
'
      UserForm1.LabelProg.Width = 78
    UserForm1.LabelProg.Caption = "56%"
    DoEvents
''    Sheets("Cost Sources").Range("A3").Select
''    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
''    Selection.ClearContents
'
'Transfer***************
'Cost Sources
'
'   Clear existing data if any
    Range(Sheets("Cost Sources").Range("A3"), Sheets("Cost Sources").Range("A3").SpecialCells(xlLastCell)).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
'
    Sheets("DM Cost Sources").Range("B8").Value = "Last transferred on: " & Now
''    Sheets("Cost Source Details").Select
         '       Range("A3").Select
         '       Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
         '       Selection.ClearContents
         '   Range("A3").Select
'
'
'Cost Source Details
'
'   Clear existing data if any
    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
'
    Sheets("DM Cost Source Details").Range("J5").Value = "Last transferred on: " & Now
'
        UserForm1.LabelProg.Width = 105
      UserForm1.LabelProg.Caption = "75%"
    UserForm1.LabelGenerate.Width = 42
    DoEvents
''    Sheets("Associated Costs").Select
''    Range("A3").Select
''    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
''    Selection.ClearContents
'
'
'Associated Costs
'
'   Clear existing data if any
    Range(Sheets("Associated Costs").Range("A3"), Sheets("Associated Costs").Range("A3").SpecialCells(xlLastCell)).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").Range("B8").Value = "Last transferred on: " & Now
''    Sheets("Vendors").Select
''    Range("A3").Select
''    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
''    Selection.ClearContents
'
'
'Vendors
'
'   Clear existing data if any
    Range(Sheets("Vendors").Range("A3"), Sheets("Vendors").Range("A3").SpecialCells(xlLastCell)).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")
'
    Sheets("DM Vendors").Range("B8").Value = "Last transferred on: " & Now
'
    UserForm1.Hide
'
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

gheyman
  • Solved
VB Run-time error '91':
Replies
4
Views
688
Fluff
Fluff
gheyman
  • Question Question
Code error when it gets to Refreshing a table(s)
Replies
0
Views
335
gheyman
gheyman
gheyman
  • Locked
  • Solved
Code not pasting a cell
Replies
2
Views
464
Peter_SSs
Peter_SSs
gheyman
  • Solved
Run time error
Replies
5
Views
609
Joe4
Joe4
gheyman
  • Question Question
Last Row LR8 = Sheets("Cost Sources").Cells(Rows.Count, "A").End(xlUp).Row?
Replies
1
Views
651
Joe4
Joe4

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

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