auf der suche nach dem passenden skript

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Probiers mal damit, hab allerdings nicht ganz verstanden, was folgender Satz:
"kopiere mappe2, spalte a1 bis zu dieser letzten zelle ins spalte d nach mappe1. beginne das einfügen in spalte b2." heißen sollte, denke mal du willst die Zellen:
a1:d (letzte Zeile) aus Mappe 2 in Mappe 1 kopieren.
Hoffe es sind keine Tippfehler drinnen, sonst einfach in ein Standardmodul kopieren.


Sub kopieren()
dim rngArea as excel.range
dim wkbHost as workbook, wkbTarget as workbook
dim wksHost as workbook, wksTarget as workbook
dim lngRow as long
set wkbTarget=workbooks("Mappe1.xls") 'hier den Namen der Mappe1 einsetzen
set wkbHost=workbooks("Mappe2.xls") 'Hier name der Mappe2
set wksTarget=wkbtarget.worksheets("Tabelle1") 'Hier die TAbelle aus Mappe1
set wkshost=wkbhost.worksheets("tabelle1") 'Hier die Tabelle aus Mappe2
'Hier sucht er mal die Zeile, wenn die letzte leer ist, schaut er von unten, sonst
'von oben
if wkstarget.cells(65536,4).value<>0 then
lngrow=wkstarget.cells(1,4).end(xldown).row
else
lngrow=wkstarget.cells(65536,4).end(xlup).row
endif
'Löschen
wkstarget.cells(2,2).offset(0,0).range("a1:c" & lngrow-2).clearcontents
'Suchen in Mappe2
if wkshost.cells(65536,4).value<>0 then
lngrow=wkshost.cells(1,4).end(xldown).row
else
lngrow=wkshost.cells(65536,4).end(xlup).row
endif
set rngarea=wkshost.ceLls(1,1).offset(0,0).range("a1:d" & lngrow).copy
wkstarget.cells(2,2).pastespecial xlall
application.cutcopymode=false
End Sub

mfg Stefan

Sub kopieren() Dim rngArea As Excel.Range Dim wkbHost As Workbook, wkbTarget As Workbook Dim wksHost As Workbook, wksTarget As Workbook Dim lngRow As Long Set wkbTarget = Workbooks("Test_Forum_Makro.xls") 'hier den Namen der Mappe1 einsetzen Set wkbHost = Workbooks("Test_Forum_Makro.xls") 'Hier name der Mappe2 Set wksTarget = wkbTarget.Worksheets("Tabelle1") 'Hier die TAbelle aus Mappe1 --> da knallt es !!!!! Set wksHost = wkbHost.Worksheets("Tabelle2") 'Hier die Tabelle aus Mappe2 'Hier sucht er mal die Zeile, wenn die letzte leer ist, schaut er von unten, sonst 'von oben If wksTarget.Cells(65536, 4).Value <> 0 Then lngRow = wksTarget.Cells(1, 4).End(xlDown).Row Else lngRow = wksTarget.Cells(65536, 4).End(xlUp).Row End If 'Löschen wksTarget.Cells(2, 2).Offset(0, 0).Range("a1:c" & lngRow - 2).ClearContents 'Suchen in Mappe2 If wksHost.Cells(65536, 4).Value <> 0 Then lngRow = wksHost.Cells(1, 4).End(xlDown).Row Else lngRow = wksHost.Cells(65536, 4).End(xlUp).Row End If Set rngArea = wksHost.Cells(1, 1).Offset(0, 0).Range("a1:d" & lngRow).Copy wksTarget.Cells(2, 2).PasteSpecial xlAll Application.CutCopyMode = False End Sub

Sub kopieren() Dim rngArea As Excel.Range Dim wkbHost As Workbook, wkbTarget As Workbook Dim wksHost As Worksheet, wksTarget As Worksheet Dim lngRow As Long Set wkbTarget = Workbooks("Mappe2.xls") 'hier den Namen der Mappe1 einsetzen Set wkbHost = Workbooks("Mappe3.xls") 'Hier name der Mappe2 Set wksTarget = wkbTarget.Worksheets("tabelle1") 'Hier die TAbelle aus Mappe1 Set wksHost = wkbHost.Worksheets("tabelle1") 'Hier die Tabelle aus Mappe2 'Hier sucht er mal die Zeile, wenn die letzte leer ist, schaut er von unten, sonst 'von oben If wksTarget.Cells(65536, 4).Value <> 0 Then lngRow = wksTarget.Cells(1, 4).End(xlDown).Row Else lngRow = wksTarget.Cells(65536, 4).End(xlUp).Row End If 'Löschen wksTarget.Cells(2, 2).Offset(0, 0).Range("a1:c" & lngRow - 2).ClearContents 'Suchen in Mappe2 If wksHost.Cells(65536, 4).Value <> 0 Then lngRow = wksHost.Cells(1, 4).End(xlDown).Row Else lngRow = wksHost.Cells(65536, 4).End(xlUp).Row End If wksHost.Cells(1, 1).Offset(0, 0).Range("a1:d" & lngRow).Copy wksTarget.Cells(2, 2).PasteSpecial xlAll Application.CutCopyMode = False End Sub

Beliebteste Forumthreads (12 Monate)

auf der suche nach dem passenden skript

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread