Empresas
Empregos
  • Sobre nós
  • Soluções
    • Publicação de vagas
      Publique sua vaga e receba candidatos qualificados em 48h.
    • Avaliações de candidatos
      Mais de 500 testes técnicos e psicológicos, mais anti-fraude.
    • Headhunting
      Busca executiva personalizada do início ao fim.
    • Folha de Pagamento + EOR
      Dispersão de folha e EOR em mais de 15 países da LATAM.
  • Preços
  • Empregos

0

375
Visualizações
Subscription out of Range with Set TargetWS = Workbooks("Result.xlsx").Worksheet(2)

I am new to VBA and trying to select few column based on header of 2 file and compare them. To achieve this I am copying the column based on header such xx,yy,zz from 2 sheet to new sheet leaving few column as blank to separate 2 sheet data and compare the column. Diff will be highlighted in red.

enter image description here

Tried below code to copy data but I am getting subscription out of range for target file(highlighted below).

Sub CopyByHeader()

    Dim CurrentWS As Worksheet
    Set CurrentWS = ActiveSheet

    Dim SourceWS As Worksheet
    Set SourceWS = Workbooks("ALL_01.00.xls").Worksheets(1)
    Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
    Dim SourceCell As Range
    
    Dim fl As Object
    Set fl = CreateObject("scripting.filesystemobject").GetFile("Result.xlsx")

    If fl Is Nothing Then
    Workbooks.Add.SaveAs Filename:="Result"
    End If
    
    Dim TargetWS As Worksheet
    **Set TargetWS = Workbooks("Result.xlsx").Worksheet(2)**
    Dim TargetHeader As Range
    Set TargetHeader = TargetWS.Range("A1:AX1")
    Dim RealLastRow As Long
    Dim SourceCol As Integer
    Dim Header() As Variant
    Dim k As Integer
    HeaderList = Array("xx", "yy", "zz")
    SourceWS.Activate
    For Each Cell In TargetHeader
        If Cell.Value <> "" Then
            Set SourceCell = Rows(SourceHeaderRow).Find _
                (Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not SourceCell Is Nothing Then
                SourceCol = SourceCell.Column
                RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If RealLastRow > SourceHeaderRow Then
                    Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
                        SourceCol)).Copy
                    TargetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues
                End If
            End If
        End If
    Next

    CurrentWS.Activate

End Sub
about 4 years ago · Santiago Trujillo
Responde à pergunta
Encontrar trabalhos remotos

Descubra a nova forma de encontrar um emprego!

melhores empregos
Principais categorias de trabalho
Empresas
Postar vaga Preços Comercial
Jurídico
Termos e Condições Política de privacidade
© 2026 PeakU Inc. All Rights Reserved.
Andres GPT
Recomende algumas ofertas para mim
Preciso de ajuda