複製範圍從另一個工作簿

林有點新的Excel VBA，我堅持的東西，我試過一些東西，但我不知道足以讓它正確。複製範圍從另一個工作簿

這是事情，我有一個工作簿1中的窗體，我從日曆中選擇一個開始日期和結束日期，一旦選擇我按下一個按鈕，我必須從一個關閉的文件複製讓我們調用workbook2所有從開始日期到結束日期的元素。

所以，如果我從19-08-2013選擇25-08-2013，我想元2元11被複制到workbook1

Workbook2（千元素日期等）：

╔═══╦════════════╦═════════════╦═════════════╦═════════════╦═════════════╗ 
║ ║ A  ║  B  ║  c  ║  D  ║  E  ║ 
╠═══╬════════════╬═════════════╬═════════════╬═════════════╬═════════════╣ 
║ 1 ║ Type  ║ Element 1 ║    ║ 16-08-2013 ║ 18-08-2013 ║ 
║ 1 ║ Type  ║ Element 2 ║    ║ 19-08-2013 ║ 22-08-2013 ║ 
║ 2 ║ Header  ║ Element 3 ║    ║ 19-08-2013 ║ 22-08-2013 ║ 
║ 3 ║ Auto Align ║ Element 4 ║    ║ 19-08-2013 ║ 22-08-2013 ║ 
║ 4 ║ Auto Align ║ Element 5 ║    ║ 19-08-2013 ║ 22-08-2013 ║ 
║ 5 ║ Auto Align ║ Element 6 ║    ║ 19-08-2013 ║ 22-08-2013 ║ 
║ 6 ║ Auto Align ║ Element 7 ║    ║ 23-08-2013 ║ 25-08-2013 ║ 
║ 7 ║ Auto Align ║ Element 8 ║    ║ 23-08-2013 ║ 25-08-2013 ║ 
║ 8 ║ Auto Align ║ Element 9 ║    ║ 23-08-2013 ║ 25-08-2013 ║ 
║ 9 ║ Auto Align ║ Element 10 ║    ║ 23-08-2013 ║ 25-08-2013 ║ 
║10 ║ Auto Align ║ Element 11 ║    ║ 23-08-2013 ║ 25-08-2013 ║ 
║11 ║ Auto Align ║ Element 12 ║    ║ 26-08-2013 ║ 01-09-2013 ║ 
║12 ║ Auto Align ║ Element 13 ║    ║ 26-08-2013 ║ 01-09-2013 ║ 
║13 ║ Auto Align ║ Element 14 ║    ║ 26-08-2013 ║ 01-09-2013 ║ 
║14 ║ Auto Align ║ Element 15 ║    ║ 26-08-2013 ║ 01-09-2013 ║ 
║15 ║ Auto Align ║ Element 16 ║    ║ 26-08-2013 ║ 01-09-2013 ║ 
║.. ║ ...  ║  ...  ║  ...  ║  ...  ║  ...  ║ 
║ n ║  n  ║ Element n ║    ║ start date ║ end date ║ 
╚═══╩════════════╩═════════════╩═════════════╩═════════════╩═════════════╝

workbook1：

╔═══╦════════════╗ 
║ ║ A  ║ 
╠═══╬════════════╣ 
║ 1 ║ Element 2 ║ 
║ 2 ║ Element 3 ║ 
║ 3 ║ Element 4 ║ 
║ 4 ║ Element 5 ║ 
║ 5 ║ Element 6 ║ 
║ 6 ║ Element 7 ║ 
║ 7 ║ Element 8 ║ 
║ 8 ║ Element 9 ║ 
║ 9 ║ Element 10 ║ 
║10 ║ Element 11 ║ 
╚═══╩════════════╝

這是我有我的更新（actualizar）按鈕至今：

私人小組actualizar_Click（）

If calendario.SelStart + 6 = calendario.SelEnd Then //calendario is the calendar 
    Sheets("variables").Range("B1").Value = calendario.SelStart //i just copy the 
    Sheets("variables").Range("B2").Value = calendario.SelEnd //selected date to wb1 

    '///// code to get data 

    Dim wb As Workbook 
    Application.ScreenUpdating = False ' turn off the screen updating 
    Set wb = Workbooks.Open("C:\Users\G\Desktop\AnalyticsBuilder\Panel a completarCOPIA.xlsx", True, True) 
    ' open the source workbook, read only 


    Dim c As Range 
    Dim x As Range 
    Set x = Range("C5") 

    For Each c In wb.Worksheets("2012").Range("K:K") 
     If c.Value >= calendario.SelStart And c.Value <= calendario.SelEnd Then 

      ThisWorkbook.Worksheets("variables").x.Value = wb.Worksheets("2012").c.Value 

     End If 
    Next c 


    wb.Close False ' close the source workbook without saving any changes 
    Set wb = Nothing ' free memory 

    Application.ScreenUpdating = True ' turn on the screen updating 
    Unload Me 

ElseIf calendario.SelStart + 6 <> calendario.SelEnd Then 
    MsgBox ("Seleccionar semana completa"), , "Error" 
End If

末次

我一直在試圖將電池從封閉WB2複製成功，但是這個代碼來獲取元素是行不通的。

從關閉的wb複製也使excel在獲取數據之前凍結了幾秒鐘，有沒有辦法解決這個問題？

希望你能幫到這個，謝謝你提前。

來源

2013-09-01 gepex

看here。但以下是我有時使用的東西。

Function xFind2B(xS As Worksheet) 
    On Error Resume Next 

    Dim c As Range 
    Dim xRng As Range 
    Set xRng = xS.Range("D1:D20") 

    For Each c In xRng 
     If c.Value => textbox.value And <= textbox2.value Then 
      'Do Your copy 
      Exit For 
     End If 
    Next c 

    xFind2BlanksA = c.Offset(-1).Row 

    On Error GoTo 0 
End Function

來源

2013-09-01 08:22:01

也許......

Private Sub actualizar_Click() 

    Dim wsDest As Worksheet 
    Dim DateCell As Range 
    Dim arrResults(1 To 65000) As Variant 
    Dim ResultIndex As Long 

    Set wsDest = ThisWorkbook.Sheets("variables") 

    If calendario.SelStart + 6 = calendario.SelEnd Then '//calendario is the calendar 

     wsDest.Range("B1:B2").Value = Application.Transpose(Array(calendario.SelStart, calendario.SelEnd)) 

     Application.ScreenUpdating = False ' turn off the screen updating 
     With Workbooks.Open("C:\Users\G\Desktop\AnalyticsBuilder\Panel a completarCOPIA.xlsx", True, True) 

      For Each DateCell In Intersect(.Sheets("2012").UsedRange, .Sheets("2012").Columns("K")) 
       If IsDate(DateCell.Value) Then 
        If DateCell.Value >= calendario.SelStart And DateCell.Value <= calendario.SelEnd Then 
         ResultIndex = ResultIndex + 1 
         arrResults(ResultIndex) = DateCell.Text 
        End If 
       End If 
      Next DateCell 
      .Close False 
     End With 

     If ResultIndex > 0 Then wsDest.Cells(Rows.Count, "C").End(xlUp).Offset(1).Resize(ResultIndex).Value = Application.Transpose(arrResults) 

     Application.ScreenUpdating = True ' turn on the screen updating 
     Unload Me 

    ElseIf calendario.SelStart + 6 <> calendario.SelEnd Then 
     MsgBox ("Seleccionar semana completa"), , "Error" 
    End If 

End Sub

來源

2013-09-03 19:03:09 tigeravatar

複製範圍從另一個工作簿

回答

相關問題