表格不复制数据

Question

Sub CostPriceMain()

Dim SourceWkb As Workbook
Dim TargetWkb As Workbook
Dim SourceWksht As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files         
(*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)

If NewFile = False Then Exit Sub
If NewFile <> False Then
Set SourceWkb = Workbooks.Open(NewFile)
End If

Set TargetWkb = Workbooks.Open("C:\WK24.xlsx") ' warning - XLS file could cause problems - see note

For Each SourceWksht In SourceWkb.Worksheets
If SourceWksht.Visible Then
     SourceWkb.Sheets("Price List").Range("C:E").Copy
     TargetWkb.Sheets("Price List").Range("C:E").PasteSpecial Paste:=xlValues
End If

Next SourceWksht

TargetWkb.Close False
SourceWkb.Close False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Done = MsgBox("Task Complete", vbOKOnly)

End Sub

我的主要问题似乎与

       SourceWkb.Sheets("Price List").Range("C:E").Copy
       TargetWkb.Sheets("Price List").Range("C:E").PasteSpecial Paste:=xlValues

它运行没有问题，但实际上并没有复制数据，我似乎无法弄清楚为什么 我试过了

   TargetWkb.Sheets("Price List").Range("A:A").Value = SourceWkb.Sheets("Price 
   List").Range("A:A")

Bit 在没有数据的情况下仍然得到相同的结果，有什么想法吗？

Answer 1

您的代码中有一些奇怪之处。最值得注意的是：

 'Here you loop through every worksheet in your source workbook
    'but you only copy one specific sheet. This is superfluous and 
    'may be causing the issue (although it shouldn't)
    For Each SourceWksht In SourceWkb.Worksheets
        If SourceWksht.Visible Then
             SourceWkb.Sheets("Price List").Range("C:E").Copy
             TargetWkb.Sheets("Price List").Range("C:E").PasteSpecial Paste:=xlValues
        End If
    Next SourceWksht

试试这个快速重写，看看问题是否解决了。我添加了 cmets 来说明每个代码块在做什么，以防它阐明任何误解。

Sub CostPriceMain()

    Dim SourceWkb As Workbook
    Dim TargetWkb As Workbook       

    'shhh
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'ask user for excel file to source from
    NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel File (*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)

    'Did they pick a file?
    If Not NewFile = False Then 
        Set SourceWkb = Workbooks.Open(NewFile)
    Else 
        Exit Sub
    End If

    'Set up the target workbook
    Set TargetWkb = Workbooks.Open("C:\WK24.xlsx") ' warning - XLS file could cause problems - see note

    'Copy the price list from source workbook on the tab called "Price List"
    'For columns C through E. Copying it to the Target Workbook to the tab
    'called "Price List" using the same columns, only copying the values.
    SourceWkb.Sheets("Price List").Range("C:E").Copy
    TargetWkb.Sheets("Price List").Range("C:E").PasteSpecial Paste:=xlValues

    'Clean up
    TargetWkb.Close False
    SourceWkb.Close False

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    'Notify user
    Done = MsgBox("Task Complete", vbOKOnly)

End Sub