Folgender Code kopiert mir aus einer sehr großen Datei die wichtigsten Daten heraus und fügt sie eine neue Datei ein. Dies erspart enorm Zeit und Aufwand. Ich möchte dem VBA nun beibringen nur eine bestimmte Range zu kopieren und auch angeben in welchem Range er in der neuen Datei einfügen darf. Der bisherige Code sieht so aus:
Option Explicit
Sub SuchenKopieren()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lngI As Long
Dim zell As Range
Dim strPfad As String
Dim strDatei As String
Dim bolMappeGeschlossen As Boolean
strPfad = "L:\Eigene Dateien\test"
strDatei = "Servicekostenreport.xls"
On Error Resume Next
Set wksQ = Workbooks(strDatei).Worksheets("Query_Kosten")
If Err.Number 0 Then
Err.Clear
bolMappeGeschlossen = True
Set wksQ = Workbooks.Open(strPfad & strDatei, 0).Worksheets("Query_Kosten")
End If
lngI = 16
For Each wksZ In ThisWorkbook.Worksheets
If wksZ.Name "Kommentar_Speicher" And _
wksZ.Name "Kommentar_Alt" And _
wksZ.Cells(1, 1) "1" Then
wksZ.Range(wksZ.Cells(lngI + 1, 1), wksZ.Cells(lngI + 1, wksZ.Columns.Count)).Clear
For Each zell In wksQ.Range("L20", wksQ.Range("L" & wksQ.Rows.Count).End(xlUp))
If UCase(zell) = UCase(wksZ.Cells(1, 1)) Then
lngI = lngI + 1
zell.EntireRow.Copy wksZ.Range("A" & lngI)
End If
Next
wksZ.Range("A:J,Q:Z,AB:AM,AO:AZ,BB:BN,K:L").EntireColumn.Hidden = True
lngI = 16
End If
Next
If bolMappeGeschlossen = True Then Workbooks(strDatei).Close False
End Sub
Das Range der Quelle (wksQ) soll sich auf "L20 to BN3000" belaufen, dass des Zieles (wksZ) auf "A2 to BN3000" .. in der Spalte BO stehen wichtige Kommentare die keinesfalls überschrieben werden dürfen und das ist bis dato das Problem das ich zu lösen versuche und wobei ihr mir hoffentlich helfen könnt.