Excel VBA: erro durante a seleção de intervalo durante a iteração de pastas de trabalho

1

Eu tenho vários arquivos em uma pasta com a coluna "Part Number", mas nem todos estão no mesmo número de coluna. A lista não necessariamente começa na mesma linha.

Então, primeiro procuro pela string "Part Number" e depois copio seu endereço como o início do intervalo que desejo copiar.

A coluna "Part Number" tem alguns espaços em branco em alguns itens, então eu não poderia usar .End (xlDown) para pesquisar a última linha.

Então eu uso a coluna "Qty" para encontrar a última linha e copiar o número da linha.

Eu tenho a célula onde o intervalo começa, o número da coluna e o número da linha onde o intervalo deve terminar. No entanto, recebo um erro "Application defined or object defined error".

A macro não está terminada, mas não posso avançar até resolver isso. Isso é o que eu consegui:

Option Explicit

Sub mergeworkbooks()


Dim path As String
Dim filename As String
Dim wbk As Workbook
Dim wks As Worksheet
Dim lastrow As Long
Dim lastcolumn As Long
Dim rangestart As String
Dim lastcol As Long
Dim rangefinish As String
Dim activesht As String


path = "D:\RubenBK\TEST\"
filename = Dir(path)

       Do While filename <> ""

              Set wbk = Workbooks.Open(path & filename)
              For Each wks In Worksheets
                    If Not wks.UsedRange.Find("PART NUMBER", lookat:=xlPart, MatchCase:=False) Is Nothing Then
                    wks.UsedRange.Find("PART NUMBER", lookat:=xlPart, MatchCase:=False).Activate
                    rangestart = wks.UsedRange.Find("PART NUMBER", lookat:=xlPart, MatchCase:=False).Address
                    lastcolumn = wks.UsedRange.Find("PART NUMBER", lookat:=xlPart, MatchCase:=False).Column
                    lastrow = wks.UsedRange.Find("qty", lookat:=xlPart, MatchCase:=False).End(xlDown).row
                    rangefinish = Cells(lastrow, lastcolumn).Address(xlA1)
                    activesht = ActiveSheet.Name

                    'AND HERE IS WHERE I GET THE ERROR, THE Range("rangestart: rangefinish") PART:

                    wbk.Sheets(activesht).Range("rangestart: rangefinish").Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("A10")
                    End If
                    wbk.Close
              Next
        filename = Dir
        Loop


End Sub

Alguma sugestão?

    
por Ruben 19.02.2014 / 00:28

1 resposta

1

O problema é que você tem o seu rangestart e o rangefinish agrupados nas citações.

Tente movê-los para fora das aspas e isso deve funcionar.

wbk.Sheets(activesht).Range(rangestart & ":" & rangefinish).Copy
    
por 19.02.2014 / 01:14