Zellen neben der derzeit aktiven in anderes Blatt kopieren

[Dragoner]

Hallo zusammen,

habe mal wieder ein Excel Problem, bei dem ich absolut nicht weiter komme:
Ich möchte gerne von meiner aktiven Zelle aus gesehen die fünf nachstehenden Zellen und zwei nebenstehenden Zellen kopieren und 1:1 in ein anderes benanntes Blatt kopieren. (Sprich sie sollen dort identisch abgelegt werden und zwar in A2,A3,A4,A5,A6, B2 und B3)
Der Sinn dahinter: Ich arbeite in einer automatisch erstellten Excel Mappe, suche dort nach einer Überschrift (die immer wo anders steht und immer identisch benannt ist) und kopiere als nächstes die eben benannten Zellen in ein neues Blatt.

Ich habe schon einen Code geschrieben, dieser macht aber leider nicht das, was er soll:

Code:

Worksheets("Abrechnungsübersicht").Activate
Dim str_SuchString As String
Dim Counter1 As Integer
Dim Counter2 As Integer
'Name der Überschrift die ich suche = str_SuchString
str_SuchString = "NE3 CAPEX"
For Counter1 = 1 To ActiveSheet.Cells.SpecialCells(xlLastCell).Column
 
  For Counter2 = 1 To ActiveSheet.Cells.SpecialCells(xlLastCell).Row
      If Cells(Counter2, Counter1).Value = str_SuchString Then
        Cells(Counter2, Counter1).Select
      End If
Next
Next

'die Zellen die ich kopieren möchte definiere ich nun als Array

  Dim varX As Variant, lngIndex As Long, lngRow As Long
  varX = Array(ActiveCell.Offset(1, 0), ActiveCell.Offset(2, 0), ActiveCell.Offset(3, 0), ActiveCell.Offset(4, 0), ActiveCell.Offset(5, 0), ActiveCell.Offset(1, 1), ActiveCell.Offset(2, 1))
'jetzt wechsel ich in das Blatt, wo der Array 1:1 abgelegt werden soll. Die Informationen würden nach A2, A3, A4, A5, A6 und B2 und B3 kommen
Worksheets("NE3 Capex").Activate
  Sheets("NE3 Capex").Range("A2:b6") = varX

Problem: Mein Code kopiert nach A2-A6 immer den selben wert und nach B2-B6 immer den selben Wert

Vielen Dank vorab für Lösungsvorschläge

[Dragoner]

Falls jemanden die Lösung interessiert.
Ich habe es nun über einen Umweg geschafft :)

Sub Test3()
Const strSheetName As String = "NE3 Capex"

Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0

If wsTest Is Nothing Then
Worksheets.Add.Name = strSheetName
End If

Worksheets("Abrechnungsübersicht").Activate
Dim str_SuchString As String
Dim Counter1 As Integer
Dim Counter2 As Integer
 
    ' With Worksheets("NE3 Capex")
       '  Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Copy Destination:=.Cells(.Rows.Count, 1).End(xlUp).Offset(1)
   '  End With
'Kopf der neuen Blätter befüllen
    ' ("NE3 Capex")
    Dim Datenstand As String
    Dim VHNrNE3C As String
    Dim BestellNrNE3C As String
    Dim Name As String
    Dim Abrechnungsmonat As String
    Dim Region As String
    Dim NrNE3C As String
str_SuchString = "NE3 CAPEX"
For Counter1 = 1 To ActiveSheet.Cells.SpecialCells(xlLastCell).Column
   
    For Counter2 = 1 To ActiveSheet.Cells.SpecialCells(xlLastCell).Row
        If Cells(Counter2, Counter1).Value = str_SuchString Then
          Cells(Counter2, Counter1).Select
        End If
  Next
Next
   
    Datenstand = ActiveCell.Offset(1, 0).Value
    VHNrNE3C = ActiveCell.Offset(2, 0).Value
    BestellNrNE3C = ActiveCell.Offset(3, 0).Value
    Name = ActiveCell.Offset(4, 0).Value
    Abrechnungsmonat = ActiveCell.Offset(5, 0).Value
    Region = Range("c" & ActiveCell.Row + 1).Value
    NrNE3C = Range("c" & ActiveCell.Row + 2).Value
 
'("Daten in den einzelnen Blättern einfügen")
    Worksheets("NE3 Capex").Activate
    Range("b2").Value = Datenstand
    Range("b3").Value = VHNrNE3C
    Range("b4").Value = BestellNrNE3C
    Range("b5").Value = Name
    Range("b6").Value = Abrechnungsmonat
    Range("c2").Value = Region
    Range("c3").Value = NrNE3C
End Sub

[Elex]

Hi

Alternativ sollte es auch so funktionieren. 
Erklärung:  Range("A1:A5") A1 ist nicht der absolute Bereich auf dem Blatt sondern die linke obere Zelle des Versatzes.

Code:

ActiveCell.Offset(1, 0).Range("A1:A5").Copy Destination:=Worksheets("NE3 Capex").Range("B2")

ActiveCell.Offset(1, 1).Range("A1:A2").Copy Destination:=Worksheets("NE3 Capex").Range("c2")